C     PROGRAM SNOOPY                                                            
C     SIGN CONTROL CARD IS 4 FIELDS OF 14 CHARACTERS                            
      REAL*8 LETTER(7,8,6),SECT(15),ALETTE(7,48)                  
      LOGICAL*1 SIGN(80)
      EQUIVALENCE (ALETTE,LETTER)                                              
      LOGICAL*1 CSER(48)
      REAL*8 DOG(34)                                                         
      EQUIVALENCE (IDOG,DOG)                                                    
      REAL*8 BLANK                                                       
      DATA BLANK/8H        /
      CALL OPEN (2,'PICKET.DAT',0,'RDO')
      CALL OPEN (3,'PICKET.OUT',0,'NEW')
      READ (2,101) (CSER(I),I=1,48)
      IGOA=4HGO A
      WRITE (3,9999)                                                           
 9999 FORMAT(1HQ)                                                               
25    CONTINUE                                                                  
      READ(2,100)  (((LETTER(IL,IR,IG),IR=1,8),IL=1,7),IG=1,6)                 
      WRITE (3,1005)                                                          
1000  FORMAT(1X,2H**, 14(A8,1X),2H**)                                     
 1001 FORMAT(1X,2H**,126X,2H**)                                                 
 1006 FORMAT(1X,10(13H*************))                                    
 1005 FORMAT(1H1)                                                               
100   FORMAT(8(A8,1X))                                                          
      READ (2,101,END=525) (SIGN(I),I=1,80)
101   FORMAT(80A1)                                                              
      WRITE (3,1006)                                                           
      WRITE (3,1006)                                                          
      WRITE (3,1001)                                                           
      DO 20 IBL=1,4                                                             
      DO 15 IR=1,7                                                              
      DO 10  I=1,14                                                             
      IJBL=((IBL-1)*14)+I                                                       
      DO 50  J=1,48                                                             
      IF(SIGN(IJBL).EQ.CSER(J))GO TO 51                                         
50    CONTINUE                                                                  
      SECT(I)=BLANK                                                             
      GO TO 10                                                                  
51    SECT(I)=ALETTE(IR,J)                                                     
10    CONTINUE                                                                  
      WRITE (3,1000) (SECT(K),K=1,14)                      
  15  CONTINUE                                                                  
      WRITE (3,1001)                                        
      WRITE (3,1001)                                                           
  20  CONTINUE                                                                  
      WRITE (3,1006)                                                           
      WRITE (3,1006)                                    
   3  READ(2,102)(DOG(I),I=1,34)                                               
      IF(IDOG.EQ.IGOA) GOTO 1                                               
   2  WRITE (3,103) (DOG(I),I=1,34)                  
102   FORMAT(10(A4,A4))                                             
103   FORMAT(1X,34A4)                                              
      GO TO 3                                                                   
  1   CONTINUE                                                                  
      CALL YEARS                                                                
      REWIND 2                                                                 
C     GO TO  25                                                                 
525   CONTINUE                                                                  
      END                                                                       
      SUBROUTINE YEARS                                                          
          DIMENSION MHED(102), LMNTHS(12),NUMS(14,10),KK(14)        
          INTEGER*4 MP(7,6,12),MO(42,12)                                        
          EQUIVALENCE(MP,MO)                                                    
      REAL NUMS                                                                 
      REAL MHED                                                                 
      DATA LMNTHS/31,26,31,30,31,30,31,31,30,31,30,31/
        READ(2,100) ((NUMS(I,J),I=1,14),J=1,10)                                 
100   FORMAT(7(A4,A3))                                                      
      READ (2,202)IFYR,ILYR                                                 
202       FORMAT(2I5)                                                           
          IF(ILYR+1.EQ.1)ILYR=IFYR                                              
          READ(2,200)MHED                                                      
200   FORMAT(20A4/14A4)                                               
2         DO 6 IYR=IFYR,ILYR                                                    
8         IF(IYR.GT.9999) STOP 3                                                
          I1=IYR/1000                             
          I=IYR-I1*1000                                                         
          I2=I/100                                
          I=I-I2*100                                                            
          I3=I/10                                   
          I4=I-10*I3                                  
      WRITE (3,203) (NUMS(I,I1+1),NUMS(I+1,I1+1),NUMS(I,I2+1),NUMS(I+1
     2,I2+1),NUMS(I,I3+1),NUMS(I+1,I3+1),NUMS(I,I4+1),NUMS(I+1,I4+1)
     3,I=1,14,2)
203       FORMAT(//7(53X,8A4/) )                                                
          CALL LFEB(IYR,LMNTHS(2),IJAN)                                        
          DO 9 M=1,12                                                           
          DO 10 I=1,42                                                          
10        MO(I,M)=(2H  )                               
          KJAN=IJAN+LMNTHS(M)-1                                                
          DO 11 I=IJAN,KJAN                                                     
          N=I-IJAN+1                                                            
11        ENCODE(10,204,MO(I,M))N                                               
204       FORMAT(I2)                                                            
          IJAN=IJAN+LMNTHS(M)                                                  
          IJAN=IJAN-IJAN/7*7                                                    
          IF(IJAN.EQ.0)IJAN=7                                                   
9     CONTINUE                                                                  
          WRITE (3,205) (MHED(I),I=1,34),(MHED(I),I=69,102)         
205       FORMAT( //,2(34A4 ,/))                                     
      DO 667 J=1,6
  667 WRITE (3,206) ((MP(I,J,K),I=1,7),K=1,6)
  206 FORMAT (3X,5(7(A2,1X),1X),6(A2,1X),A2)
          WRITE (3,205) (MHED(I),I=35,102)                     
      DO 668 J=1,6
  668 WRITE (3,206) ((MP(I,J,K),I=1,7),K=7,12)
    6 CONTINUE
      RETURN                                                                    
          END                                                                   
          FUNCTION LF(NY)                                                       
          IF(NY.LT.1000)STOP 1                                                  
          LF=28                                                                 
          IF(NY/4*4.NE.NY)GO TO 1                                               
          LF=29                                                                 
          IF(NY/100*100.NE.NY)GO TO 1                                           
          LF=28                                                                 
          IF(NY/400*400.NE.NY)GO TO 1                                           
          LF=29                                                                 
1         RETURN                                                                
          END                                                                   
          SUBROUTINE LFEB(NYR,LFB,IJAN)                                         
          LFB=LF(NYR)                                                           
          IJAN=4                                                                
          IF(NYR.EQ.1000)RETURN                                                 
          DO 1 NY=1001,NYR                                                      
1         IJAN=IJAN+LF(NY-1)+1                                                  
          IJAN=IJAN-IJAN/7*7                                                    
          IF(IJAN.EQ.0)IJAN=7                                                   
          RETURN                                                                
          END