Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50247/prthlc.f4
There are no other files named prthlc.f4 in the archive.
      SUBROUTINE PENHLT (LASTX,LASTY,NEWX,NEWY)
C     PENHLT SINGLE PAGE PRINTER                                03/23/68
C     GENPLT-II COUPLING SUBROUTINE PENHLT FOR ONE PAGE PRINTER PLOTS
C
C     DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
C     SINGLE PAGE PLOTS ARE FOR TESTING NEW ROUTINES AT GENPLT-II LEVEL.
C     SUCH MIGHT BE USED FOR TESTING NEW DATA PLOTTING METHODS OR FONTS.
C     RESOLUTION IS TOO POOR FOR TESTING ROUTINES WHICH CALL GENPLT-II.
C
      DIMENSION N1(16),N2(4),N3(2),N4(16),N5(4),LIST(31)
C
      COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,NTAPE,MODE,IPOINT,
     1IFREER,ILINE
C
      COMMON/PRINTR/NUMBER(2592),ITWO(30),ICOL,IBITS,IUP,IDWN,MISS,
     1MINX,MAXX,IADDX,IDIVX,MINY,MAXY,IADDY,IDIVY
C
      DATA N1(01),N1(02),N1(03),N1(04),N1(05),N1(06),N1(07),N1(08),
     1     N1(09),N1(10),N1(11),N1(12),N1(13),N1(14),N1(15),N1(16)/
     2     4H    ,4H   X,4H  X ,4H  XX,4H X  ,4H X X,4H XX ,4H XXX,
     3     4HX   ,4HX  X,4HX X ,4HX XX,4HXX  ,4HXX X,4HXXX ,4HXXXX/
C
      DATA N2(01),N2(02),N2(03),N2(04)/4H1   ,4H1X  ,4HX   ,4HXX  /
C
      DATA N3(01),N3(02)/4H1   ,4HX   /
C
      DATA N4(01),N4(02),N4(03),N4(04),N4(05),N4(06),N4(07),N4(08),
     1     N4(09),N4(10),N4(11),N4(12),N4(13),N4(14),N4(15),N4(16)/
     2     4H----,4H---X,4H--X-,4H--XX,4H-X--,4H-X-X,4H-XX-,4H-XXX,
     3     4HX---,4HX--X,4HX-X-,4HX-XX,4HXX--,4HXX-X,4HXXX-,4HXXXX/
C
      DATA N5(01),N5(02),N5(03),N5(04)/4H1-  ,4H1X  ,4HX-  ,4HXX  /
C
      DATA IPLOT/0/
C
      IF(IPLOT)1,1,4
C
C     **************INITIALIZE CONTENTS OF LABELED COMMON***************
    1 IPLOT=1
      DO 2 I=1,306
    2 NUMBER(I)=0
      ITWO(1)=1
      DO 3 I=2,20
    3 ITWO(I)=2*ITWO(I-1)
      ICOL=6
      IBITS=20
      IUP=0
      IDWN=0
      MISS=0
      MINX=0
      MAXX=100
      IADDX=204
      IDIVX=204
      MINY=0
      MAXY=50
      IADDY=21007
      IDIVY=404
      FACTOR=20603.0
      OFSETX=0.0
      OFSETY=0.0
      IERR=0
      NTAPE=6
      RETURN
C
C     *******WRITE THE PLOT IN HOLLERITH FORM ON TAPE UNIT NTAPE********
    4 DO 5 I=1,306
      IF(NUMBER(I))5,5,7
    5 CONTINUE
      IF(IUP)6,6,15
    6 RETURN
    7 LOCK=0
      KOUNT=0
      WRITE(NTAPE,8)
    8 FORMAT(1H1)
      DO 14 LINE=1,51
      IF(LOCK)12,12,9
    9 LOCK=LOCK-1
      DO 10 KOLUMN=1,5
      KOUNT=KOUNT+1
      INDEX5=NUMBER(KOUNT)/16
      INDEX4=INDEX5/16
      INDEX3=INDEX4/4
      INDEX2=INDEX3/16
      INDEX1=INDEX2/16
      INDEX6=NUMBER(KOUNT)-16*INDEX5
      INDEX5=INDEX5-16*INDEX4
      INDEX4=INDEX4-4*INDEX3
      INDEX3=INDEX3-16*INDEX2
      INDEX2=INDEX2-16*INDEX1
      NUMBER(KOUNT)=0
      LIST(6*KOLUMN)  =N1(INDEX6+1)
      LIST(6*KOLUMN-1)=N1(INDEX5+1)
      LIST(6*KOLUMN-2)=N2(INDEX4+1)
      LIST(6*KOLUMN-3)=N1(INDEX3+1)
      LIST(6*KOLUMN-4)=N1(INDEX2+1)
   10 LIST(6*KOLUMN-5)=N2(INDEX1+1)
      KOUNT=KOUNT+1
      INDEX1=1+(NUMBER(KOUNT)/524288)
      NUMBER(KOUNT)=0
      LIST(31)=N3(INDEX1)
      WRITE(NTAPE,11)(LIST(I),I=1,31)
   11 FORMAT(1X,10(A2,2A4),A1)
      GO TO 14
   12 LOCK=4
      DO 13 KOLUMN=1,5
      KOUNT=KOUNT+1
      INDEX5=NUMBER(KOUNT)/16
      INDEX4=INDEX5/16
      INDEX3=INDEX4/4
      INDEX2=INDEX3/16
      INDEX1=INDEX2/16
      INDEX6=NUMBER(KOUNT)-16*INDEX5
      INDEX5=INDEX5-16*INDEX4
      INDEX4=INDEX4-4*INDEX3
      INDEX3=INDEX3-16*INDEX2
      INDEX2=INDEX2-16*INDEX1
      NUMBER(KOUNT)=0
      LIST(6*KOLUMN)  =N4(INDEX6+1)
      LIST(6*KOLUMN-1)=N4(INDEX5+1)
      LIST(6*KOLUMN-2)=N5(INDEX4+1)
      LIST(6*KOLUMN-3)=N4(INDEX3+1)
      LIST(6*KOLUMN-4)=N4(INDEX2+1)
   13 LIST(6*KOLUMN-5)=N5(INDEX1+1)
      KOUNT=KOUNT+1
      INDEX1=1+(NUMBER(KOUNT)/524288)
      NUMBER(KOUNT)=0
      LIST(31)=N3(INDEX1)
      WRITE(NTAPE,11)(LIST(I),I=1,31)
   14 CONTINUE
   15 WRITE(NTAPE,16)IPLOT,IUP,IDWN,MISS
   16 FORMAT(1H0,4HPLOT,1I4,12H SUMMARY ***,1I6,19H PENUP COMMANDS ***,1
     1I6,20H PENDWN COMMANDS ***,1I6,16H LINES NOT SHOWN)
      IERR=MISS
      MISS=0
      IUP=0
      IDWN=0
      IPLOT=IPLOT+1
      RETURN
      END