C     SNOOPY CALENDAR PROGRAM FOR PDP-11 FORTRAN
C     HACKED CODE TO PRINT INDIVIDUAL SNOOPY PICTURES

      IMPLICIT REAL*8 (A-H,O-Z)                                                 
      DIMENSION AMONTH (12,7,13), ANAM(22), ANUM(2,10,5), NODS(12),             
     1          CAL(60,22)                                                      
      COMMON ISET                                                               
      DIMENSION ILINE(133),INUM(50),ICHR(50)
C     CALL OPEN (2,'SNPCAL.DAT',0,'RDO')
      OPEN (UNIT=2,FILE='SNPCAL.DAT',READONLY,STATUS='OLD')
C     CALL OPEN (7,'SNPCAL.OUT',0,'NEW')
C      OPEN (UNIT=7,FILE='SNPCAL.OUT',STATUS='UNKNOWN')
C     CLOSE (UNIT=7,DISPOSE='DELETE')
C      CLOSE (UNIT=7,DISPOSE='DELETE')
C      OPEN (UNIT=7,FILE='SNPCAL.OUT',STATUS='NEW')
      OPEN (UNIT=7,FILE='SNPCAL.OUT',ACTION='WRITE',STATUS='REPLACE')
      READ (2,1) (((AMONTH(I,J,K),K=1,13),J=1,7),I=1,12)                        
      READ (2,2) (ANAM(I),I=1,22)                                               
      READ (2,3) (((ANUM(I,J,K),J=1,10),K=1,5),I=1,2)                           
      READ (2,4) (NODS(I),I=1,12)                                               
      READ (2,1) BLANK,ONE,ALIN1,ALIN2,ALIN3,ALIN4                              
      READ (2,4) MF,IYR,MTHLST,IYRLST,LNSW                                      
      ISET=25
C     IMAGE TO BE PRINTED IS IPIC
      READ (*,*) IPIC
      DO 10 J=1,IPIC-1
 55   READ (2,1000) (INUM(I),ICHR(I),I=1,ISET)
      DO 40 I=1,ISET
      IF (INUM(I) .EQ. -2) GOTO 10
 40   CONTINUE
      GO TO 55
 10   CONTINUE
      CALL SNPPIC
C     WRITE OUTPUT TAPE 1,5,((CAL(I,J),J=1,22),I=1,60)                          
C      WRITE (7,5) ((CAL(I,J),J=1,22),I=1,60)                                    

 100  STOP                                                                      
1     FORMAT (13A6)                                                             
2     FORMAT (11A6)                                                             
3     FORMAT (10A6)                                                             
4     FORMAT (12I6)                                                             
5     FORMAT (22A6)                                                             
    6 FORMAT(/,1X)                                                              
 1000 FORMAT (25(I2,A1))
      END                                                                       


      SUBROUTINE SNPPIC
C     THIS SUBROUTINE WILL ANALYZE THE INPUT DATA AND PRINT A PICTURE
C     YOU CAN EXPECT TO GET 1 WARNING MESSAGE DURING COMPILATION
      DIMENSION ILINE(133),INUM(50),ICHR(50)
      COMMON ISET
      DATA IBLNK/1H /
      DO 4 I=1,133
    4 ILINE(I)=IBLNK
    5 K=1
   10 READ (2,1000) (INUM(I),ICHR(I),I=1,ISET)
      DO 40 I=1,ISET
      IF (INUM(I) .NE. -1) GOTO 100
C     HERE WE WRITE A LINE TO THE PRINTER AND GO BUILD ANOTHER
      DO 15 L=K,133
   15 ILINE(L)=ICHR(I)
      WRITE (*,2000) (ILINE(K),K=1,131)
      ILINE(1)=IBLNK
      DO 20 K=2,133
   20 ILINE(K)=ICHR(I)
      K=1
C      I=I+1
  100 IF (INUM(I) .EQ. -2) GOTO 200
      IF (INUM(I) .EQ. 0) GOTO 40
      DO 30 J=1,INUM(I)
      ILINE(K)=ICHR(I)
      K=K+1
   30 CONTINUE
   40 CONTINUE
      GOTO 10
C     HERE WE EXIT THE PICTURE AND RETURN TO THE CALLING PROGRAM
  200 RETURN
C     FORMAT STATEMENTS
 1000 FORMAT (25(I2,A1))
 2000 FORMAT (133A1)
      END
