C     .TITLE CO
C
C   3 JAN 75 (PDH) RE-COMBINE THE CONSTRUCTION FILES 'CO' 'OP' 'CEE'
C                  'OH' 'UNDERO' 'INOH' 'COP' 'PMAJ' AND 'INPEE'
C   2 JAN 75 (PDH) CHANGE FOR DISPLAY FILE STORAGE ON DISK
C  13 DEC 74 (PDH) PUT 'ITAG' IN COMMON
C   5 DEC 74 (PDH) UPDATE TO USE 'CEE' & 'OH'
C   1 NOV 74 (PDH) SPLIT OFF FROM ORIGINAL 'CO-OP'
C
      SUBROUTINE CO
C
      COMMON /TAGS/ITAG,INDEX
C
C  ALL FILES STORED FROM SUBROUTINE 'CO' HAVE INDEX OF 1 OR 3
C
      INDEX = INDEX + 1
C
C  DRAW 'C'
C
      CALL CEE
C
C  DRAW 'O'
C
      CALL OH
      RETURN
      END
C     .TITLE OP
C
C   2 JAN 75 (PDH) CHANGE FOR DISPLAY FILE STORAGE ON DISK
C  13 DEC 74 (PDH) PUT 'ITAG' IN COMMON
C  30 NOV 74 (PDH) CONVERT COMPLETELY TO NEW TECHNIQUE
C  26 NOV 74 (PDH) SET UP VARIABLES FOR 'CALL PART13'
C  20 NOV 74 (PDH) CHANGE SHADING IN LARGER 'O' WITH 'PMAJ'
C   1 NOV 74 (PDH) SPLIT OFF FROM ORIGINAL 'CO-OP'
C
      SUBROUTINE OP
C
      COMMON /TAGS/ITAG,INDEX
C
C  ALL FILES STORED FROM SUBROUTINE 'OP' HAVE INDEX OF 2 OR 4
C
      INDEX = INDEX + 1
C
C  DRAW SHADING IN 'C'
C
C  FIRST BELOW THE SMALLER 'O'
C
      CALL UNDERO
C
C  DRAW IN CENTRE OF SMALLER 'O'
C
      CALL INOH
C
C  FILL IN BETWEEN SMALLER 'O' & 'P'
C
      CALL COP
C
C  AND NOW INSIDE THE LARGER 'O'
C
      CALL PMAJ
C
C  AND FINALLY INSIDE THE 'P'
C
      CALL INPEE
      RETURN
      END
C     .TITLE CEE
C
C  13 DEC 74 (PDH) PUT 'ITAG' IN COMMON
C  12 DEC 74 (PDH) REMOVE ALL DEBUGGING CODE
C   9 DEC 74 (PDH) FIX UP A COUPLE OF DISCREPANCIES
C   5 DEC 74 (PDH) DERIVE 'CEE' FROM 'PMAJ'
C  27 NOV 74 (PDH) CORRECT EXPRESSION FOR 'Y2'
C  20 NOV 74 - PAUL HENDERSON
C
C  SUBROUTINE TO GENERATE THE 'C'
C
      SUBROUTINE CEE
C
      LOGICAL F/.FALSE./,ISENSW
      REAL Y1/0.4/,Y2/1.2/,Y11/12.3/,Y12/13.1/
C
      COMMON /LIMITS/XMIN,XMAX,YMIN,YMAX
      COMMON /ANGLES/PIBY4,PI5BY4
      COMMON /TAGS/ITAG
      COMMON /PAINT/PICT(4,101)
      COMMON /OIL/IVECT(800)
C
      FY  = (YMAX-YMIN)/1023.
      Y3 = 3.5 + 3.1*SIN(PI5BY4)
      Y4 = 3.5 + 2.3*SIN(PI5BY4)
      Y5 = 3.5 + 2.3*SIN(PIBY4)
      Y6 = 3.5 + 3.1*SIN(PIBY4)
      Y7 = 10. + 3.1*SIN(PI5BY4)
      Y8 = 10. + 2.3*SIN(PI5BY4)
      Y9 = 10. + 2.3*SIN(PIBY4)
      Y10= 10. + 3.1*SIN(PIBY4)
C
      X00 = Y7
      Y00 = Y3
      X01 = Y8
      Y01 = Y4
      X02 = Y4
      Y02 = Y8
      R23SQ = 2.3*2.3
      R31SQ = 3.1*3.1
      N = 0
      IDEX = 1
C
C  USE DO-LOOP TO PROCESS 100 LINES AT A TIME
C
 199  DO 200 K=1,100
      YN = N*FY + Y1
      IF (YN .GE. Y12) GO TO 220
      N = N + 1
C
C  PUT NEW Y VALUES IN 'PICT' ARRAY
C
      PICT(2,K) = YN
      PICT(4,K) = YN
      PICT(2,K+1) = YN
      PICT(4,K+1) = YN
C
C  NOW ESTABLISH X-COORDINATE OF END 1 OF LINE
C
 100  GO TO (101,102,103,104,105,106,107,107,109,109,111),IDEX
C
C  'XT' IS DERIVED FROM THE FORMULA FOR A CIRCLE (X**2 + Y**2 = R**2)
C
 101  XT = SQRT (ABS (R31SQ-(YN-3.5)*(YN-3.5)))
      PICT(1,K) = 10.0 - XT
      GO TO 300
C
 102  YSQ = (YN-3.5)*(YN-3.5)
      XT  = SQRT (R31SQ - YSQ)
      XT2 = SQRT (ABS (R23SQ - YSQ))
      PICT(1,K)   = 10.0 - XT
      PICT(1,K+1) = 10.0 + XT2
      IF (YN .LT. Y3) GO TO 300
      IDEX = 3
C
 103  YSQ = (YN-3.5)*(YN-3.5)
      XT  = SQRT (R31SQ - YSQ)
      XT2 = SQRT (R23SQ - YSQ)
      PICT(1,K)   = X00 + Y00 - YN
      PICT(1,K+1) = 10.0 + XT2
      GO TO 300
C
 104  YSQ = (YN-3.5)*(YN-3.5)
      PICT(1,K)   = X00 + Y00 - YN
      PICT(1,K+1) = 10.0 + SQRT (R23SQ - YSQ)
      IF (YN .LT. Y5) GO TO 300
      IDEX = 5
C
 105  YSQ = (YN-3.5)*(YN-3.5)
      PICT(1,K)   = X00 + Y00 - YN
      PICT(1,K+1) = X00 - Y00 + YN
      GO TO 300
C
 106  PICT(1,K) = X00 + Y00 - YN
      IF (YN .LT. Y7) GO TO 300
      IDEX = 7
C
 107  YSQ = (YN-10.0)*(YN-10.0)
      PICT(1,K) = 3.5 - SQRT (R31SQ - YSQ)
      GO TO 300
C
 109  YSQ = (YN-10.0)*(YN-10.0)
      XT  = SQRT (R31SQ - YSQ)
      XT2 = SQRT (ABS (R23SQ - YSQ))
      PICT(1,K)   = 3.5 - XT
      PICT(1,K+1) = 3.5 + XT2
      GO TO 300
C
 111  XT = SQRT (R31SQ - (YN-10.0)*(YN-10.0))
      PICT(1,K) = 3.5 - XT
C
C  NOW ESTABLISH X-COORINATE OF END 2 OF LINE.  LINES RUN FROM
C  LEFT TO RIGHT
C
 300  GO TO (301,302,302,304,304,306,306,308,309,310,311),IDEX
C
 301  PICT(3,K) = 10.0 + XT
      IF (YN .LT. Y2) GO TO 200
      IDEX = 2
      GO TO 100
C
 302  PICT(3,K)   = 10.0 - XT2
      PICT(3,K+1) = 10.0 + XT
      IF (YN .LT. Y4) GO TO 391
      IDEX = 4
C
 304  PICT(3,K)   = X01 + Y01 - YN
      PICT(3,K+1) = 10.0 + SQRT (R31SQ - YSQ)
      IF (YN .LT. Y6) GO TO 391
      IDEX = 6
C
 306  PICT(3,K) = X01 + Y01 - YN
      IF (YN .LT. Y8) GO TO 200
      IDEX = 8
C
 308  PICT(3,K) = 3.5 - SQRT (R23SQ - YSQ)
      IF (YN .LT. Y9) GO TO 200
      IDEX = 9
      GO TO 100
C
 309  PICT(3,K)   = 3.5 - XT2
      PICT(3,K+1) = X02 - Y02 + YN
      IF (YN .LT. Y10) GO TO 391
      IDEX = 10
C
 310  PICT(3,K)   = 3.5 - XT2
      PICT(3,K+1) = 3.5 + XT
      IF (YN .LT. Y11) GO TO 391
      IDEX = 11
      GO TO 100
C
 311  PICT(3,K) = 3.5 + XT
      GO TO 200
C
C  FOR CASES OF 2 LINE SEGMENTS, K MUST BE INCREMENTED TO ACCOUNT FOR
C  THE SECOND SEGMENT
C
 391  K = K + 1
C
 200  CONTINUE
C
 220  IF (K .LT. 2) RETURN
      CALL VECTOR (1,PICT,1,K-1,IVECT,1,LAST,5,1,F)
      IF (ISENSW(1)) WRITE (4,*) 'N',N,'LAST',LAST
      ITAG = ITAG + 1
      CALL DISPLY (6,ITAG,IVECT,1,LAST)
      IF (YN .LT. Y12) GO TO 199
      RETURN
      END
C     .TITLE OH
C
C  13 DEC 74 (PDH) PUT 'ITAG' IN COMMON
C  12 DEC 74 (PDH) REMOVE ALL DEBUGGING CODE
C  10 DEC 74 (PDH) DERIVE 'OH' FROM 'CEE'
C   9 DEC 74 (PDH) FIX UP A COUPLE OF DISCREPANCIES
C   5 DEC 74 (PDH) DERIVE 'CEE' FROM 'PMAJ'
C  27 NOV 74 (PDH) CORRECT EXPRESSION FOR 'Y2'
C  20 NOV 74 - PAUL HENDERSON
C
C  SUBROUTINE TO GENERATE THE 'C'
C
      SUBROUTINE OH
C
      LOGICAL F/.FALSE./,ISENSW
      REAL Y1/4.9/,Y2/5.7/,Y11/16.8/,Y12/17.6/
C
      COMMON /LIMITS/XMIN,XMAX,YMIN,YMAX
      COMMON /ANGLES/PIBY4,PI5BY4
      COMMON /TAGS/ITAG
      COMMON /PAINT/PICT(4,101)
      COMMON /OIL/IVECT(800)
C
      FY  = (YMAX-YMIN)/1023.
      Y3 =  8.0 + 3.1*SIN(PI5BY4)
      Y4 =  8.0 + 2.3*SIN(PI5BY4)
      Y5 =  8.0 + 2.3*SIN(PIBY4)
      Y6 =  8.0 + 3.1*SIN(PIBY4)
      Y7 = 14.5 + 3.1*SIN(PI5BY4)
      Y8 = 14.5 + 2.3*SIN(PI5BY4)
      Y9 = 14.5 + 2.3*SIN(PIBY4)
      Y10= 14.5 + 3.1*SIN(PIBY4)
C
      X00 = Y7
      Y00 = Y3
      X01 = Y8
      Y01 = Y4
      X02 = Y9
      Y02 = Y5
      X03 = Y10
      Y03 = Y6
      R23SQ = 2.3*2.3
      R31SQ = 3.1*3.1
      N = 0
      IDEX = 1
C
C  USE DO-LOOP TO PROCESS 100 LINES AT A TIME
C
 199  DO 200 K=1,100
      YN = N*FY + Y1
      IF (YN .GE. Y12) GO TO 220
      N = N + 1
C
C  PUT NEW Y VALUES IN 'PICT' ARRAY
C
      PICT(2,K) = YN
      PICT(4,K) = YN
      PICT(2,K+1) = YN
      PICT(4,K+1) = YN
C
C  NOW ESTABLISH X-COORDINATE OF END 1 OF LINE
C
 100  GO TO (101,102,103,104,105,105,107,107,109,109,111),IDEX
C
C  'XT' IS DERIVED FROM THE FORMULA FOR A CIRCLE (X**2 + Y**2 = R**2)
C
 101  XT = SQRT (ABS (R31SQ-(YN-8.0)*(YN-8.0)))
      PICT(1,K) = 14.5 - XT
      GO TO 300
C
 102  YSQ = (YN-8.0)*(YN-8.0)
      XT  = SQRT (R31SQ - YSQ)
      XT2 = SQRT (ABS (R23SQ - YSQ))
      PICT(1,K)   = 14.5 - XT
      PICT(1,K+1) = 14.5 + XT2
      IF (YN .LT. Y3) GO TO 300
      IDEX = 3
C
 103  YSQ = (YN-8.0)*(YN-8.0)
      XT  = SQRT (R31SQ - YSQ)
      XT2 = SQRT (R23SQ - YSQ)
      PICT(1,K)   = X00 + Y00 - YN
      PICT(1,K+1) = 14.5 + XT2
      GO TO 300
C
 104  YSQ = (YN-8.0)*(YN-8.0)
      PICT(1,K)   = X00 + Y00 - YN
      PICT(1,K+1) = 14.5 + SQRT (ABS (R23SQ - YSQ))
      IF (YN .LT. Y5) GO TO 300
      IDEX = 5
C
 105  YSQ = (YN-8.0)*(YN-8.0)
      PICT(1,K)   = X00 + Y00 - YN
      PICT(1,K+1) = X02 + Y02 - YN
      IF (YN .LT. Y7) GO TO 300
      IDEX = 7
C
 107  YSQ = (YN-14.5)*(YN-14.5)
      PICT(1,K)   = 8.0 - SQRT (R31SQ - YSQ)
      PICT(1,K+1) = X02 + Y02 - YN
      IF (YN .LT. Y9) GO TO 300
      IDEX = 9
C
 109  YSQ = (YN-14.5)*(YN-14.5)
      XT  = SQRT (R31SQ - YSQ)
      XT2 = SQRT (ABS (R23SQ - YSQ))
      PICT(1,K)   = 8.0 - XT
      PICT(1,K+1) = 8.0 + XT2
      GO TO 300
C
 111  XT = SQRT (R31SQ - (YN-14.5)*(YN-14.5))
      PICT(1,K) = 8.0 - XT
C
C  NOW ESTABLISH X-COORINATE OF END 2 OF LINE.  LINES RUN FROM
C  LEFT TO RIGHT
C
 300  GO TO (301,302,302,304,304,306,306,308,308,310,311),IDEX
C
 301  PICT(3,K) = 14.5 + XT
      IF (YN .LT. Y2) GO TO 200
      IDEX = 2
      GO TO 100
C
 302  PICT(3,K)   = 14.5 - XT2
      PICT(3,K+1) = 14.5 + XT
      IF (YN .LT. Y4) GO TO 391
      IDEX = 4
C
 304  PICT(3,K)   = X01 + Y01 - YN
      PICT(3,K+1) = 14.5 + SQRT (R31SQ - YSQ)
      IF (YN .LT. Y6) GO TO 391
      IDEX = 6
C
 306  PICT(3,K)   = X01 + Y01 - YN
      PICT(3,K+1) = X03 + Y03 - YN
      IF (YN .LT. Y8) GO TO 391
      IDEX = 8
C
 308  PICT(3,K)   = 8.0 - SQRT (ABS (R23SQ - YSQ))
      PICT(3,K+1) = X03 + Y03 - YN
      IF (YN .LT. Y10) GO TO 391
      IDEX = 10
C
 310  PICT(3,K)   = 8.0 - XT2
      PICT(3,K+1) = 8.0 + XT
      IF (YN .LT. Y11) GO TO 391
      IDEX = 11
      GO TO 100
C
 311  PICT(3,K) = 8.0 + XT
      GO TO 200
C
C  FOR CASES OF 2 LINE SEGMENTS, K MUST BE INCREMENTED TO ACCOUNT FOR
C  THE SECOND SEGMENT
C
 391  K = K + 1
C
 200  CONTINUE
C
 220  IF (K .LT. 2) RETURN
      CALL VECTOR (1,PICT,1,K-1,IVECT,1,LAST,5,1,F)
      IF (ISENSW(1)) WRITE (4,*) 'N',N,'LAST',LAST
      ITAG = ITAG + 1
      CALL DISPLY (6,ITAG,IVECT,1,LAST)
      IF (YN .LT. Y12) GO TO 199
      RETURN
      END
C     .TITLE UNDERO
C
C  13 DEC 74 (PDH) PUT 'ITAG' IN COMMON
C  12 DEC 74 (PDH) REMOVE ALL DEBUGGING CODE
C  30 NOV 74 (PDH' DERIVE 'UNDERO' FROM 'COP'
C  30 NOV 74 (PDH) DERIVE 'COP' FROM 'PMAJ'
C  27 NOV 74 (PDH) CORRECT EXPRESSION FOR 'Y2'
C  20 NOV 74 - PAUL HENDERSON
C
C  SUBROUTINE TO PERFORM THE SHADING BELOW THE SMALLER 'O'
C
      SUBROUTINE UNDERO
C
      LOGICAL F/.FALSE./,ISENSW
      REAL Y1/1.3/,Y2,Y3/4.3/
C
      COMMON /LIMITS/XMIN,XMAX,YMIN,YMAX
      COMMON /ANGLES/PIBY4,PI5BY4
      COMMON /TAGS/ITAG
      COMMON /PAINT/PICT(4,100)
      COMMON /OIL/IVECT(800)
C
      FY  = (YMAX-YMIN)/1023.
      X0  = 10. + 2.2*COS(PI5BY4)
      Y0  = 3.5 + 2.2*SIN(PI5BY4)
      Y2  = 3.5 + 2.2*SIN(PI5BY4)
      R22SQ = 2.2*2.2
      N = 0
      IDEX = 1
C
C  USE DO-LOOP TO PROCESS 100 LINES AT A TIME
C
 199  DO 200 K=1,100
      YN = N*FY + Y1
      IF (YN .GE. Y3) GO TO 220
      N = N + 1
C
C  PUT NEW Y VALUES IN 'PICT' ARRAY
C
      PICT(2,K) = YN
      PICT(4,K) = YN
C
C  NOW ESTABLISH X-COORDINATE OF END 2 OF LINE
C
C  'XT' IS DERIVED FROM THE FORMULA FOR A CIRCLE (X**2 + Y**2 = R**2)
C
 300  XT = SQRT (ABS (R22SQ - (YN-3.5)*(YN-3.5)))
      PICT(3,K) = XT + 10.0
C
C  NOW ESTABLISH X-COORINATE OF END 1 OF LINE.  LINES RUN FROM
C  LEFT TO RIGHT
C
 100  GO TO (101,102),IDEX
C
 101  PICT(1,K) = -XT + 10.0
      IF (YN .LE. Y2) GO TO 200
      IDEX = 2
C
 102  PICT(1,K) = X0 + Y0 - YN
C
 200  CONTINUE
C
 220  IF (K .LT. 2) RETURN
      CALL VECTOR (1,PICT,1,K-1,IVECT,1,LAST,5,1,F)
      IF (ISENSW(1)) WRITE (4,*) 'N',N,' LAST',LAST
      ITAG = ITAG + 1
      CALL DISPLY (6,ITAG,IVECT,1,LAST)
      IF (YN .LT. Y3) GO TO 199
      RETURN
      END
C     .TITLE INOH
C
C  13 DEC 74 (PDH) PUT 'ITAG' IN COMMON
C  12 DEC 74 (PDH) REMOVE DEBUGGING CODE
C  30 NOV 74 (PDH) DERIVE 'INOH' FROM 'UNDERO'
C  30 NOV 74 (PDH' DERIVE 'UNDERO' FROM 'COP'
C  30 NOV 74 (PDH) DERIVE 'COP' FROM 'PMAJ'
C  27 NOV 74 (PDH) CORRECT EXPRESSION FOR 'Y2'
C  20 NOV 74 - PAUL HENDERSON
C
C  SUBROUTINE TO PERFORM THE SHADING INSIDE THE SMALLER 'O'
C
      SUBROUTINE INOH
C
      LOGICAL F/.FALSE./,ISENSW
      REAL Y1/6.35/,Y2/6.85/
C
      COMMON /LIMITS/XMIN,XMAX,YMIN,YMAX
      COMMON /ANGLES/PIBY4,PI5BY4
      COMMON /TAGS/ITAG
      COMMON /PAINT/PICT(4,100)
      COMMON /OIL/IVECT(800)
C
      FY  = (YMAX-YMIN)/1023.
      X0  = 10. + 3.1*COS(PIBY4)
      Y0  = 3.5 + 3.1*SIN(PIBY4)
      R25SQ = 0.25*0.25
      N = 0
C
C  USE DO-LOOP TO PROCESS 100 LINES AT A TIME
C
 199  DO 200 K=1,100
      YN = N*FY + Y1
      IF (YN .GE. Y2) GO TO 220
      N = N + 1
C
C  PUT NEW Y VALUES IN 'PICT' ARRAY
C
      PICT(2,K) = YN
      PICT(4,K) = YN
C
C  NOW ESTABLISH X-COORDINATE OF END 2 OF LINE
C
 300  PICT(3,K) = X0 + Y0 - YN
C
C  NOW ESTABLISH X-COORINATE OF END 1 OF LINE.  LINES RUN FROM
C  LEFT TO RIGHT
C
 100  PICT(1,K) = -SQRT (ABS (R25SQ - (YN-6.6)*(YN-6.6))) + 6.6
C
 200  CONTINUE
C
 220  IF (K .LT. 2) RETURN
      CALL VECTOR (1,PICT,1,K-1,IVECT,1,LAST,5,1,F)
      IF (ISENSW(1)) WRITE (4,*) 'N',N,' LAST',LAST
      ITAG = ITAG + 1
      CALL DISPLY (6,ITAG,IVECT,1,LAST)
      IF (YN .LT. Y2) GO TO 199
      RETURN
      END
C     .TITLE COP
C
C  13 DEC 74 (PDH) PUT 'ITAG' IN COMMON
C  12 DEC 74 (PDH) REMOVE DEBUGGING CODE
C  30 NOV 74 (PDH) DERIVE FROM 'PMAJ'
C  27 NOV 74 (PDH) CORRECT EXPRESSION FOR 'Y2'
C  20 NOV 74 - PAUL HENDERSON
C
C  SUBROUTINE TO PERFORM NEARLY ALL THE SHADING IN
C  THE LARGER 'O'
C
      SUBROUTINE COP
C
      LOGICAL F/.FALSE./,ISENSW
      REAL Y1,Y2/6.6/,Y3,Y4/8.9/,Y5/9.4/,Y6,Y7/12.2/
C
      COMMON /LIMITS/XMIN,XMAX,YMIN,YMAX
      COMMON /ANGLES/PIBY4,PI5BY4
      COMMON /TAGS/ITAG
      COMMON /PAINT/PICT(4,100)
      COMMON /OIL/IVECT(800)
C
      FY  = (YMAX-YMIN)/1023.
      X0  = 10. + 2.2*COS(PI5BY4)
      Y0  = 3.5 + 2.2*SIN(PI5BY4)
      X0R = 10. + 3.1*COS(PIBY4)
      Y0R = 3.5 + 3.1*SIN(PIBY4)
      Y1  = X0 + Y0 - 4.3
      Y3  = 10. + 2.2*SIN(PI5BY4)
      YN  = 0.8/2.2
      Y6  = 10. + 2.2*SIN(ATAN(SQRT(1.-YN*YN)/YN))
      R22SQ = 2.2*2.2
      R23SQ = 2.3*2.3
      N = 0
      IDEX = 1
C
C  USE DO-LOOP TO PROCESS 100 LINES AT A TIME
C
 199  DO 200 K=1,100
      YN = N*FY + Y1
      IF (YN .GE. Y7) GO TO 220
      N = N + 1
C
C  PUT NEW Y VALUES IN 'PICT' ARRAY
C
      PICT(2,K) = YN
      PICT(4,K) = YN
C
C  NOW ESTABLISH X-COORDINATE OF END 2 OF LINE
C
 300  GO TO (302,302,301,301,301,301),IDEX
C
C  'XT' IS DERIVED FROM THE FORMULA FOR A CIRCLE (X**2 + Y**2 = R**2)
C
 301  XT = SQRT (ABS (R22SQ - (YN-10.0)*(YN-10.0)))
      PICT(3,K) = -XT + 3.5
      GO TO 100
C
 302  PICT(3,K) = X0 + Y0 - YN
      IF (YN .LE. Y3) GO TO 100
      IDEX = 3
      GO TO 300
C
C  NOW ESTABLISH X-COORINATE OF END 1 OF LINE.  LINES RUN FROM
C  RIGHT TO LEFT
C
 100  GO TO (101,103,103,104,105,106),IDEX
C
 101  PICT(1,K) = 4.3
      IF (YN .LE. Y2) GO TO 200
      IDEX = 2
C
 103  PICT(1,K) = -SQRT (ABS (R23SQ - (YN-6.6)*(YN-6.6))) + 6.6
      IF (YN .LT. Y4) GO TO 200
      IDEX = 4
C
 104  PICT(1,K) = X0R + Y0R - YN
      IF (YN .LE. Y5) GO TO 200
      IDEX = 5
C
 105  PICT(1,K) = 4.3
      IF (YN .LE. Y6) GO TO 200
      IDEX = 6
C
 106  PICT(1,K) = +XT + 3.5
C
 200  CONTINUE
C
 220  IF (K .LT. 2) RETURN
      CALL VECTOR (1,PICT,1,K-1,IVECT,1,LAST,5,1,F)
      IF (ISENSW(1)) WRITE (4,*) 'N',N,' LAST',LAST
      ITAG = ITAG + 1
      CALL DISPLY (6,ITAG,IVECT,1,LAST)
      IF (YN .LT. Y7) GO TO 199
      RETURN
      END
C     .TITLE PMAJ
C
C  13 DEC 74 (PDH) PUT 'ITAG' IN COMMON
C  12 DEC 74 (PDH) REMOVE DEBUGGING CODE
C  27 NOV 74 (PDH) CORRECT EXPRESSION FOR 'Y2'
C  20 NOV 74 - PAUL HENDERSON
C
C  SUBROUTINE TO PERFORM NEARLY ALL THE SHADING IN
C  THE LARGER 'O'
C
      SUBROUTINE PMAJ
C
      LOGICAL F/.FALSE./,ISENSW
      REAL Y1/5.8/,Y3/6.6/,Y4/8.9/,Y5/9.4/,Y7/11.15/
      REAL Y8/11.4/,Y9/13.7/,Y11/16.7/
C
      COMMON /LIMITS/XMIN,XMAX,YMIN,YMAX
      COMMON /ANGLES/PIBY4,PI5BY4,PI
      COMMON /TAGS/ITAG
      COMMON /PAINT/PICT(4,100)
      COMMON /OIL/IVECT(800)
C
      FY  = (YMAX-YMIN)/1023.
      X0  = 14.5 + 2.2*COS(PIBY4)
      Y0  =  8.0 + 2.2*SIN(PIBY4)
      X0L = 14.5 + 2.2*COS(PI5BY4)
      Y0L =  8.0 + 2.2*SIN(PI5BY4)
      YN  = -0.8/2.2
      Y2 = PI - ATAN (SQRT (1.0 - YN*YN) / YN)
      Y2 = 8.0 + 2.2*SIN(Y2)
      Y6  = Y0
      Y10 = X0
      R22SQ = 2.2*2.2
      R23SQ = 2.3*2.3
      N = 0
      IDEX = 1
C
C  USE DO-LOOP TO PROCESS 100 LINES AT A TIME
C
 199  DO 200 K=1,100
      YN = N*FY + Y1
      IF (YN .GE. Y11) GO TO 220
      N = N + 1
C
C  PUT NEW Y VALUES IN 'PICT' ARRAY
C
      PICT(2,K) = YN
      PICT(4,K) = YN
C
C  NOW ESTABLISH X-COORDINATE OF END 2 OF LINE
C
 300  GO TO (301,301,301,301,301,302,302,302,303,303),IDEX
C
C  'XT' IS DERIVED FROM THE FORMULA FOR A CIRCLE (X**2 + Y**2 = R**2)
C
 301  XT = SQRT (ABS (R22SQ - (YN-8.0)*(YN-8.0)))
      PICT(3,K) = XT + 14.5
      GO TO 100
C
 302  PICT(3,K) = X0 + Y0 - YN
      GO TO 100
C
C  FROM HERE UP, WE DRAW FROM RIGHT TO LEFT
C
 303  XT = SQRT (R22SQ - (YN-14.5)*(YN-14.5))
      PICT(3,K) = -XT + 8.0
C
C  NOW ESTABLISH X-COORINATE OF END 1 OF LINE.  LINES RUN FROM
C  LEFT TO RIGHT UNTIL IDEX REACHES 9
C
 100  GO TO (101,102,103,104,105,106,107,108,109,110),IDEX
C
 101  PICT(1,K) = -XT + 14.5
      IF (YN .LE. Y2) GO TO 200
      IDEX = 2
C
 102  PICT(1,K) = 13.7
      IF (YN .LE. Y3) GO TO 200
      IDEX = 3
C
 103  PICT(1,K) = SQRT (ABS (R23SQ - (YN-6.6)*(YN-6.6))) + 11.4
      IF (YN .LT. Y4) GO TO 200
      IDEX = 4
C
 104  PICT(1,K) = X0L + Y0L - YN
      IF (YN .LE. Y5) GO TO 200
      IDEX = 5
C
 105  PICT(1,K) = 13.7
      IF (YN .LE. Y6) GO TO 200
      IDEX = 6
C
 106  PICT(1,K) = 13.7
      IF (YN .LT. Y7) GO TO 200
      IDEX = 7
C
 107  PICT(1,K) = 11.5
      IF (YN .LE. Y8) GO TO 200
      IDEX = 8
C
 108  PICT(1,K) = SQRT (ABS (R23SQ - (YN-11.4)*(YN-11.4))) + 9.2
      IF (YN .LT. Y9) GO TO 200
      IDEX = 9
      GO TO 300
C
 109  PICT(1,K) = X0 + Y0 - YN
      IF (YN .LE. Y10) GO TO 200
      IDEX = 10
C
 110  PICT(1,K) = +XT + 8.0
C
 200  CONTINUE
C
 220  IF (K .LT. 2) RETURN
      CALL VECTOR (1,PICT,1,K-1,IVECT,1,LAST,5,1,F)
      IF (ISENSW(1)) WRITE (4,*) 'N',N,' LAST',LAST
      ITAG = ITAG + 1
      CALL DISPLY (6,ITAG,IVECT,1,LAST)
      IF (YN .LT. Y11) GO TO 199
      RETURN
      END
C     .TITLE INPEE
C
C  13 DEC 74 (PDH) PUT 'ITAG' IN COMMON
C  12 DEC 74 (PDH) REMOVE DEBUGGING CODE
C  30 NOV 74 (PDH) DERIVE 'INPEE' FROM 'INOH'
C  30 NOV 74 (PDH) DERIVE 'INOH' FROM 'UNDERO'
C  30 NOV 74 (PDH' DERIVE 'UNDERO' FROM 'COP'
C  30 NOV 74 (PDH) DERIVE 'COP' FROM 'PMAJ'
C  27 NOV 74 (PDH) CORRECT EXPRESSION FOR 'Y2'
C  20 NOV 74 - PAUL HENDERSON
C
C  SUBROUTINE TO PERFORM THE SHADING INSIDE THE 'P'
C
      SUBROUTINE INPEE
C
      LOGICAL F/.FALSE./,ISENSW
      REAL Y1/11.15/,Y2/11.4/,Y3/11.65/
C
      COMMON /LIMITS/XMIN,XMAX,YMIN,YMAX
      COMMON /ANGLES/PIBY4,PI5BY4
      COMMON /TAGS/ITAG
      COMMON /PAINT/PICT(4,100)
      COMMON /OIL/IVECT(800)
C
      FY  = (YMAX-YMIN)/1023.
      X0  = 8. + 2.2*COS(PI5BY4)
      Y0  = 14.5 + 2.2*SIN(PI5BY4)
      R25SQ = 0.25*0.25
      N = 0
      IDEX = 1
C
C  USE DO-LOOP TO PROCESS 100 LINES AT A TIME
C
 199  DO 200 K=1,100
      YN = N*FY + Y1
      IF (YN .GE. Y3) GO TO 220
      N = N + 1
C
C  PUT NEW Y VALUES IN 'PICT' ARRAY
C
      PICT(2,K) = YN
      PICT(4,K) = YN
C
C  NOW ESTABLISH X-COORDINATE OF END 2 OF LINE
C
 300  PICT(3,K) = X0 + Y0 - YN
C
C  NOW ESTABLISH X-COORINATE OF END 1 OF LINE.  LINES RUN FROM
C  RIGHT TO LEFT
C
 100  GO TO (101,102),IDEX
C
 101  PICT(1,K) = 9.45
      IF (YN .LE. Y2) GO TO 200
      IDEX = 2
C
 102  PICT(1,K) = SQRT (ABS (R25SQ - (YN-11.4)*(YN-11.4))) + 9.2
C
 200  CONTINUE
C
 220  IF (K .LT. 2) RETURN
      CALL VECTOR (1,PICT,1,K-1,IVECT,1,LAST,5,1,F)
      IF (ISENSW(1)) WRITE (4,*) 'N',N,' LAST',LAST
      ITAG = ITAG + 1
      CALL DISPLY (6,ITAG,IVECT,1,LAST)
      IF (YN .LT. Y3) GO TO 199
      RETURN
      END