Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50247/dimplt.f4
There are no other files named dimplt.f4 in the archive.
      SUBROUTINE  DIMPLT  (KONTRL,XPOINT,YPOINT,  NEXT,
     1KRDBGN,KRDEND,XFIRST,YFIRST,XFINAL,YFINAL,XWIDTH,
     2YWIDTH,XCORNR,YCORNR,RELHIT,RELSPC, LASTX, LASTY)
C                                              03/21/72
C     GENPLT-II PROGRAM TO DARKEN OR HATCH AN IRREGULARLY
C     SHAPED FIGURE.  UNLIKE OUTPUT FROM DRKPLT, HATCH
C     LINES CAN BE AT ANY ANGLE.  DIMPLT ROTATES THE INPUT
C     XPOINT AND YPOINT ARRAYS PRIOR TO PROCESSING. THESE
C     ARRAYS ARE RETURNED TO THEIR ORIGINAL VALUES BEFORE
C     RETURNING TO THE CALLING PROGRAM, BUT THE USER
C     SHOULD BE AWARE THAT THERE CAN HAVE BEEN A SLIGHT
C     PRECISION LOSS.
C
C     DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C     SUBROUTINE DIMPLT ARGUMENT LIST DEFINITIONS.
C
C     KONTRL = SELECTS PERIMETER OR ANGLE OF HATCHING
C     KONTRL = NEGATIVE GIVES PERIMETER
C     KONTRL = 0 OR GREATER, HATCHING ANGLE IN DEGREES
C            = 0 GIVES HORIZONTAL HATCH LINES
C            = 90 GIVES VERTICAL HATCH LINES
C     XPOINT = ARRAY OF X COORDINATES DEFINING PERIMETER
C              OF FIGURE.
C     YPOINT = ARRAY OF Y COORDINATES DEFINING PERIMETER
C              OF FIGURE.
C     NEXT   = FIXED OR FLOATING POINT ARRAY USED AS
C              WORKING SPACE.  NEXT IS REDEFINED DURING
C              PROCESSING DESTROYING FORMER CONTENTS.
C              NEXT MUST BE DIMENSIONED SAME OR LARGER
C              THAN XPOINT AND YPOINT.  PORTION OF NEXT
C              WHICH IS USED IS PARALLEL TO USED
C              PORTIONS OF XPOINT AND YPOINT ARRAYS.
C     KRDBGN = SUBSCRIPT OF FIRST POINT TO BE PLOTTED.
C     KRDEND = SUBSCRIPT OF FINAL POINT TO BE PLOTTED.
C     XFIRST = X COORDINATE (IN SYSTEM USED FOR XPOINT)
C              TO BE PLACED AT LEFT BORDER OF PLOT AREA.
C     YFIRST = Y COORDINATE (IN SYSTEM USED FOR YPOINT)
C              TO BE PLACED AT LOWER BORDER OF PLOT AREA.
C     XFINAL = X COORDINATE (IN SYSTEM USED FOR XPOINT)
C              TO BE PLACED AT RIGHT BORDER OF PLOT AREA.
C     YFINAL = Y COORDINATE (IN SYSTEM USED FOR YPOINT)
C              TO BE PLACED AT UPPER BORDER OF PLOT AREA.
C     XWIDTH = HORIZONTAL WIDTH (AS FRACTION OF MAXIMUM)
C              OF PLOT AREA.
C     YWIDTH = VERTICAL HEIGHT (AS FRACTION OF MAXIMUM)
C              OF PLOT AREA.
C     XCORNR = X DISTANCE (AS FRACTION OF MAXIMUM
C              DIMENSION) FROM PLOTTING TABLE ORIGIN TO
C              LEFT PLOT EDGE.
C     YCORNR = Y DISTANCE (AS FRACTION OF MAXIMUM
C              DIMENSION) FROM PLOTTING TABLE ORIGIN TO
C              LOWER PLOT EDGE.
C     RELHIT = DISTANCE BETWEEN ALTERNATE PAIRS OF HATCH
C              LINES IN UNITS OF 0.02*YWIDTH.  RELHIT AND
C              RELSPC BOTH SET AT 1.0 WOULD GIVE 50
C              LINES IN DISTANCE CORRESPONDING TO HEIGHT
C              OF THE PLOT AREA.
C     RELSPC = DISTANCE BETWEEN ALTERNATE PAIRS OF HATCH
C              LINES IN UNITS OF 0.02*YWIDTH.
C     LASTX  = LAST X GRID COORDINATE PLOTTED.
C     LASTY  = LAST Y GRID COORDINATE PLOTTED.
C
      DIMENSION XPOINT(1000),YPOINT(1000),NEXT(1000),
     1SAVE(200)
      COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,
     1NTAPE,MODE,IPOINT,IFREER,ILINE
C
C     DEFINE FACTORS AND GRID COORDINATE LIMITS
      IF(KRDBGN-KRDEND)1,90,90
    1 MODE = IFREER
      XMIN=FACTOR*XCORNR + OFSETX
      YMIN=FACTOR*YCORNR + OFSETY
      XMAX=XMIN+FACTOR*XWIDTH
      YMAX=YMIN+FACTOR*YWIDTH
      XSCALE=FACTOR*XWIDTH/(XFINAL-XFIRST)
      YSCALE=FACTOR*YWIDTH/(YFINAL-YFIRST)
      IF(KONTRL)60,4,2
C
C     ********************************
C     *  ROTATE ARRAYS ABOUT ORIGIN  *
C     ********************************
C
    2 IF(KONTRL-90)5,3,5
    3 ACOS=0.0
      ASIN=1.0
      GO TO 6
    4 ACOS=1.0
      ASIN=0.0
      GO TO 6
    5 TEST=0.0174532925*FLOAT(KONTRL)
      ACOS=COS(TEST)
      ASIN=SIN(TEST)
    6 DO 7 I=KRDBGN,KRDEND
      XTHIS=(XSCALE*(XPOINT(I)-XFIRST))+XMIN
      YTHIS=(YSCALE*(YPOINT(I)-YFIRST))+YMIN
      XPOINT(I)=(XTHIS*ACOS)+(YTHIS*ASIN)
    7 YPOINT(I)=(YTHIS*ACOS)-(XTHIS*ASIN)
      XTHIS=(ACOS*YMAX)-(ASIN*XMIN)
      YTHIS=(ACOS*YMAX)-(ASIN*XMAX)
      XTHAT=(ACOS*YMIN)-(ASIN*XMIN)
      YTHAT=(ACOS*YMIN)-(ASIN*XMAX)
      YLOWER=XTHIS
      IF(YLOWER-YTHIS)9,9,8
    8 YLOWER=YTHIS
      GO TO 10
    9 XTHIS=YTHIS
   10 IF(YLOWER-XTHAT)12,12,11
   11 YLOWER=XTHAT
      GO TO 14
   12 IF(XTHIS-XTHAT)13,14,14
   13 XTHIS=XTHAT
   14 IF(YLOWER-YTHAT)16,16,15
   15 YLOWER=YTHAT
      GO TO 18
   16 IF(XTHIS-YTHAT)17,18,18
   17 XTHIS=YTHAT
C
C     **********************************
C     *  RULE HATCH OF PARALLEL LINES  *
C     **********************************
C
   18 LOCK=1
      STEP=0.02*RELHIT*FACTOR*YWIDTH
      SPACE=0.02*RELSPC*FACTOR*YWIDTH
      IF(STEP)19,19,22
   19 IF(SPACE)20,20,21
   20 SPACE=0.02*FACTOR*YWIDTH
   21 STEP=SPACE
      GO TO 24
   22 IF(SPACE)23,23,24
   23 SPACE=STEP
   24 TEST=YPOINT(KRDBGN)
      DO 26 I=KRDBGN,KRDEND
      NEXT(I)=I+1
      IF(TEST-YPOINT(I))25,26,26
   25 TEST=YPOINT(I)
   26 CONTINUE
      NEXT(KRDEND)=KRDBGN
      NEW=KRDBGN
      IF(TEST-XTHIS)28,28,27
   27 TEST=XTHIS
   28 TEST=TEST-STEP
   29 IF(TEST-YLOWER)88,30,30
   30 KOUNT=0
   31 NOW=NEW
      NEW=NEXT(NOW)
      IF(YPOINT(NOW)-TEST)38,39,32
   32 IF(YPOINT(NEW)-TEST)39,39,33
C
C     TEST FOR REMOVAL OF POINT FROM ARRAY IF LINE
C     SEGMENT IS HIGHER
   33 LAST=NOW
      IF(NOW-NEW)36,88,34
   34 NOW=NEXT(NEW)
      IF(YPOINT(NOW)-TEST)45,45,35
   35 NEW=NOW
      NEXT(LAST)=NEW
      GO TO 45
   36 NOW=NEW
      NEW=NEXT(NEW)
      IF(YPOINT(NEW)-TEST)39,39,37
   37 NEXT(LAST)=NEW
      IF(LAST-NEW)36,88,45
   38 IF(YPOINT(NEW)-TEST)44,39,39
C
C     CALCULATE INTERCEPT WITH LINE SEGMENT
   39 IF(KOUNT-200)40,44,44
   40 KOUNT=KOUNT+1
      DIST=YPOINT(NEW)-YPOINT(NOW)
      IF(DIST-0.1)41,41,43
   41 IF(DIST+0.1)43,42,42
   42 SAVE(KOUNT)=XPOINT(NOW)
      GO TO 44
   43 SAVE(KOUNT)=XPOINT(NOW)
     1+((XPOINT(NEW)-XPOINT(NOW))*(TEST-YPOINT(NOW))/DIST)
   44 IF(NOW-NEW)31,88,45
C
C     ARRANGE INTERCEPT ARRAY INTO INCREASING ORDER
   45 IF(KOUNT-(2*(KOUNT/2)))46,47,46
   46 TEST=TEST-0.05*STEP
      GO TO 29
   47 LIMIT=KOUNT-1
      DO 51 I=1,LIMIT
      SMALL=SAVE(I)
      INDEX=0
      LOWER=I+1
      DO 49 J=LOWER,KOUNT
      IF(SMALL-SAVE(J))49,49,48
   48 SMALL=SAVE(J)
      INDEX=J
   49 CONTINUE
      IF(INDEX)51,51,50
   50 SAVE(INDEX)=SAVE(I)
      SAVE(I)=SMALL
   51 CONTINUE
C
C     PLOT HATCH LINE
      LOCK=-LOCK
      IF(LOCK)52,52,54
   52 I=KOUNT
   53 XTHAT=(ACOS*SAVE(I))-(ASIN*TEST)
      YTHAT=(ACOS*TEST)+(ASIN*SAVE(I))
      XTHIS=(ACOS*SAVE(I-1))-(ASIN*TEST)
      YTHIS=(ACOS*TEST)+(ASIN*SAVE(I-1))
      GO TO 63
   54 I=1
   55 XTHAT=(ACOS*SAVE(I))-(ASIN*TEST)
      YTHAT=(ACOS*TEST)+(ASIN*SAVE(I))
      XTHIS=(ACOS*SAVE(I+1))-(ASIN*TEST)
      YTHIS=(ACOS*TEST)+(ASIN*SAVE(I+1))
      GO TO 63
   56 LIMIT=1
      IF(LOCK)57,57,59
   57 I=I-2
      IF(I)58,58,53
   58 TEST=TEST-SPACE
      GO TO 29
   59 I=I+2
      IF(I-KOUNT)55,55,28
C
C     ******************************
C     *  PLOT PERIMETER OF FIGURE  *
C     ******************************
C
   60 XTHIS=XMIN+(XSCALE*(XPOINT(KRDEND)-XFIRST))
      YTHIS=YMIN+(YSCALE*(YPOINT(KRDEND)-YFIRST))
      MODE = ILINE
      LIMIT=1
      KRD=KRDBGN-1
   61 KRD=KRD+1
      IF(KRD-KRDEND)62,62,90
   62 XTHAT=XTHIS
      YTHAT=YTHIS
      XTHIS=XMIN+(XSCALE*(XPOINT(KRD)-XFIRST))
      YTHIS=YMIN+(YSCALE*(YPOINT(KRD)-YFIRST))
   63 XSTRT=XTHAT
      XHALT=XTHIS
      XDIST=XTHIS-XTHAT
      YDIST=YTHIS-YTHAT
C
C     TEST HORIZONTAL COORDINATES FOR LINE OUTSIDE PLOT
      IF(XSTRT-XMIN)64,65,65
   64 XSTRT=XMIN
      LIMIT=1
      IF(XHALT-XMIN)87,69,69
   65 IF(XSTRT-XMAX)67,67,66
   66 XSTRT=XMAX
      LIMIT=1
      IF(XHALT-XMAX)67,67,87
   67 IF(XHALT-XMIN)68,69,69
   68 XHALT=XMIN
      GO TO 71
   69 IF(XHALT-XMAX)71,71,70
   70 XHALT=XMAX
   71 IF(ABS(XDIST)-0.1)72,73,73
   72 YSTRT=YTHAT
      YHALT=YTHIS
      GO TO 74
   73 YSTRT=YTHAT+((YDIST*(XSTRT-XTHAT))/XDIST)
      YHALT=YTHIS-((YDIST*(XTHIS-XHALT))/XDIST)
C
C     TEST VERTICAL COORDINATES FOR LINE OUTSIDE PLOT
   74 IF(YSTRT-YMIN)75,76,76
   75 YSTRT=YMIN
      LIMIT=1
      IF(YHALT-YMIN)87,80,80
   76 IF(YSTRT-YMAX)78,78,77
   77 YSTRT=YMAX
      LIMIT=1
      IF(YHALT-YMAX)78,78,87
   78 IF(YHALT-YMIN)79,80,80
   79 YHALT=YMIN
      GO TO 82
   80 IF(YHALT-YMAX)82,82,81
   81 YHALT=YMAX
   82 IF(ABS(YDIST)-0.1)84,83,83
   83 XSTRT=XTHAT+((XDIST*(YSTRT-YTHAT))/YDIST)
      XHALT=XTHIS-((XDIST*(YTHIS-YHALT))/YDIST)
C
C     PLOT THE LINE SEGMENT
   84 IF(LIMIT)86,86,85
   85 LIMIT=-1
      NEWX=XSTRT
      NEWY=YSTRT
      CALL PENUP (LASTX,LASTY,NEWX,NEWY)
   86 NEWX=XHALT
      NEWY=YHALT
      CALL PENDWN(LASTX,LASTY,NEWX,NEWY)
   87 IF(KONTRL)61,56,56
C
C     ******************************************
C     *  REMOVE ROTATION FROM ARRAY WHEN DONE  *
C     ******************************************
C
   88 DO 89 I=KRDBGN,KRDEND
      XTHIS=XPOINT(I)
      YTHIS=YPOINT(I)
      XPOINT(I)=XFIRST
     1+(((XTHIS*ACOS)-(YTHIS*ASIN)-XMIN)/XSCALE)
   89 YPOINT(I)=YFIRST
     1+(((YTHIS*ACOS)+(XTHIS*ASIN)-YMIN)/YSCALE)
   90 RETURN
      END