$DEBUG
	SUBROUTINE LINE(XF,YF,XE,YE)
	WRITE(1,'(A)')'LINE'
	WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
	WRITE(1,'(E12.7,A1,E12.7,X)')XE,',',YE
	RETURN
	END

	SUBROUTINE CLINE(X,Y,N,C)
	CHARACTER*1 C
	DIMENSION X(50),Y(50)
	WRITE(1,'(A)')'LINE'
	DO 10 I=1,N
    	WRITE(1,'(E12.7,A1,E12.7)')X(I),',',Y(I)
  10	CONTINUE
	IF(C.EQ.'0') THEN
	WRITE(1,'(A)')'C'
	ELSEIF(C.EQ.'1') THEN
	WRITE(1,'(A3)')'   '
	ENDIF
	RETURN
	END

	SUBROUTINE ARC3(XF,YF,XM,YM,XE,YE)
	WRITE(1,'(A)')'ARC'
	WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
	WRITE(1,'(E12.7,A1,E12.7)')XM,',',YM
	WRITE(1,'(E12.7,A1,E12.7)')XE,',',YE
	RETURN
	END

	SUBROUTINE CIR(XC,YC,R)
	WRITE(1,'(A)')'CIRCLE'
	WRITE(1,'(E12.7,A1,E12.7)')XC,',',YC
	WRITE(1,'(E12.7)')R
	RETURN
	END

	SUBROUTINE TRACE(X,Y,N,B)
	DIMENSION X(50),Y(50)
	WRITE(1,'(A)')'TRACE'
	WRITE(1,'(E12.7)')B
	M=N-1
	DO 10 I=1,M
  10	WRITE(1,'(E12.7,A1,E12.7)')X(I),',',Y(I)
	WRITE(1,'(E12.7,A1,E12.7,X)')X(N),',',Y(N)
	RETURN
	END

	SUBROUTINE TLINE(XF,YF,XE,YE,B)
	WRITE(1,'(A)')'TRACE'
	WRITE(1,'(E12.7)')B
  	WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
	WRITE(1,'(E12.7,A1,E12.7,X)')XE,',',YE
	RETURN
	END

	SUBROUTINE INSERT(NAME,XB,YB,XSCL,YSCL,ANG)
	CHARACTER*3 NAME
	WRITE(1,'(A)')'INSERT'
	WRITE(1,'(A12,A3)')'/HOUSEM/DWG/',NAME
	WRITE(1,'(E12.7,A1,E12.7)')XB,',',YB
	WRITE(1,'(E12.7)')XSCL
	WRITE(1,'(E12.7)')YSCL
	WRITE(1,'(E12.7)')ANG
	RETURN
	END

	SUBROUTINE LSET(LAYER)
	CHARACTER*1 LAYER
	WRITE(1,'(A)')'LAYER'
	WRITE(1,'(A)')'SET'
	WRITE(1,'(A)')LAYER
	WRITE(1,'(A2)')'  '
	RETURN
	END

	SUBROUTINE HATCH(ANGLE,SPACE,XF,YF,XE,YE)
	WRITE(1,'(A)')'HATCH'
	WRITE(1,'(A)')'U'
	WRITE(1,'(E12.7)')ANGLE
	WRITE(1,'(E12.7)')SPACE
	WRITE(1,'(A)')'N'
	WRITE(1,'(A)')'W'
	WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
	WRITE(1,'(E12.7,A1,E12.7,X)')XE,',',YE
	RETURN
	END

	SUBROUTINE DIA(XD,YD,TEXT)
	WRITE(1,'(A)')'DIAMETER'
	WRITE(1,'(E12.7,A1,E12.7)')XD,',',YD
	WRITE(1,'(A)')
	WRITE(1,'(A)')
	RETURN
	END

	SUBROUTINE ANGU(X,Y,TEXT)
	DIMENSION X(50),Y(50)
   	 INTEGER TEXT1
	CHARACTER*3 DU
      TEXT1=ABS(TEXT)
      DU='%%D'
	WRITE(1,'(A)')'DIM'
	WRITE(1,'(A)')'ANGULAR'
	WRITE(1,'(E12.7,A1,E12.7)')X(1),',',Y(1)
	WRITE(1,'(E12.7,A1,E12.7)')X(2),',',Y(2)
	WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)
	WRITE(1,'(I2,A3)')TEXT1,DU
	WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)+3
	WRITE(1,'(A)')'EXIT'
	RETURN
	END

	SUBROUTINE ANGU1(X,Y,TEXT,GCH)
	DIMENSION X(50),Y(50)
   	 INTEGER TEXT1,GCH
	CHARACTER*3 DU
      TEXT1=ABS(TEXT)
      DU='%%D'
	WRITE(1,'(A)')'DIM'
	WRITE(1,'(A)')'ANGULAR'
	WRITE(1,'(E12.7,A1,E12.7)')X(1),',',Y(1)
	WRITE(1,'(E12.7,A1,E12.7)')X(2),',',Y(2)
	WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)
	WRITE(1,'(I2,A3,A1,I2,A3,A1)')TEXT1,DU,'(',GCH,DU,')'
	WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)+3
	WRITE(1,'(A)')'EXIT'
	RETURN
	END

	SUBROUTINE TEXT(SC,H,ANG,X,Y,TXTN,ITXT,TXTA,N,AN)
	CHARACTER*1 SC,AN
	CHARACTER*10 FORM
	CHARACTER*12 TXTA
	WRITE(1,'(A)')'TEXT'
	IF(SC.EQ.'S') THEN
	WRITE(1,'(A)')'S'
	WRITE(1,'(A)')'STANDARD'
	WRITE(1,'(E12.7,A1,E12.7)')X,',',Y
	ELSEIF(SC.EQ.'R')THEN
	WRITE(1,'(A)')'C'
	WRITE(1,'(E12.7,A1,E12.7)')X,',',Y
	ENDIF
	WRITE(1,'(E12.7)')H
	WRITE(1,'(E12.7)')ANG
	IF(AN.EQ.'F')THEN
	CALL DECIM(TXTN,ND,NS)
	NF=ND+NS
	IF(NF.EQ.10)FORM='(I1)'
	IF(NF.EQ.20)FORM='(I2)'
	IF(NF.EQ.30)FORM='(I3)'
	IF(NF.EQ.40)FORM='(I4)'
	IF(NF.EQ.11)FORM='(F3.1)'
	IF(NF.EQ.21)FORM='(F4.1)'
	IF(NF.EQ.31)FORM='(F5.1)'
	IF(NF.EQ.41)FORM='(F6.1)'
	IF(NF.EQ.12)FORM='(F4.2)'
	IF(NF.EQ.22)FORM='(F5.2)'
	IF(NF.EQ.32)FORM='(F6.2)'
	IF(NF.EQ.42)FORM='(F7.2)'
	IF(NF.EQ.13)FORM='(F5.3)'
	IF(NF.EQ.23)FORM='(F6.3)'
	IF(NF.EQ.33)FORM='(F7.3)'
	IF(NF.EQ.43)FORM='(F8.3)'
	IF(NS.EQ.0)THEN
	WRITE(1,FORM)INT(TXTN+0.0001)
	ELSE
	IF(TXTN.GE.1)THEN
	WRITE(1,FORM)TXTN
	ELSE
	IF(NS.EQ.1)THEN
	IF(TXTN.GE.0.)THEN
	WRITE(1,'(A1,F2.1)')'0',TXTN
	ELSE
	WRITE(1,'(A2,F2.1)')'-0',ABS(TXTN)
	ENDIF
	ELSEIF(NS.EQ.2)THEN
	IF(TXTN.GE.0.)THEN
	WRITE(1,'(A1,F3.2)')'0',TXTN
	ELSE
	WRITE(1,'(A2,F3.2)')'-0',ABS(TXTN)
	ENDIF
	ELSEIF(NS.EQ.3)THEN
	IF(TXTN.GE.0.)THEN
	WRITE(1,'(A1,F4.3)')'0',TXTN
	ELSE
	WRITE(1,'(A2,F4.3)')'-0',ABS(TXTN)
	ENDIF
	ENDIF
	ENDIF
	ENDIF
	ELSEIF(AN.EQ.'I')THEN
	CALL DECIM(FLOAT(ITXT),ND,NS)
	IF(ND.EQ.10)FORM='(I1)'
	IF(ND.EQ.20)FORM='(I2)'
	IF(ND.EQ.30)FORM='(I3)'
	IF(ND.EQ.40)FORM='(I4)'
	WRITE(1,FORM)ITXT
	ELSEIF(AN.EQ.'A')THEN
	IF(N.EQ.1)FORM='(A1)'
	IF(N.EQ.2)FORM='(A2)'
	IF(N.EQ.3)FORM='(A3)'
	IF(N.EQ.4)FORM='(A4)'
	IF(N.EQ.5)FORM='(A5)'
	IF(N.EQ.6)FORM='(A6)'
	IF(N.EQ.7)FORM='(A7)'
	IF(N.EQ.8)FORM='(A8)'
	IF(N.EQ.9)FORM='(A9)'
	IF(N.EQ.10)FORM='(A10)'
	IF(N.EQ.11)FORM='(A11)'
	IF(N.EQ.12)FORM='(A12)'
	WRITE(1,FORM)TXTA
	ENDIF
	RETURN
	END
	
	SUBROUTINE DIM(ANGLE,X,Y,PRE,TEXT)
	DIMENSION X(50),Y(50)
	CHARACTER*3 PRE
	CHARACTER*10 FORM
	COMMON SCL
	WRITE(1,'(A)')'DIM'
	WRITE(1,'(A)')'ROTATED'
	WRITE(1,'(E12.7)')ANGLE
	WRITE(1,'(E12.7,A1,E12.7)')X(1),',',Y(1)
	WRITE(1,'(E12.7,A1,E12.7)')X(2),',',Y(2)
	WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)
	IF(PRE.EQ.'NOT')THEN
	WRITE(1,'(X)')
	WRITE(1,'(A)')'EXIT'
	RETURN
	ENDIF
	CALL DECIM(TEXT,ND,NS)
	NF=ND+NS
	IF(NF.EQ.10.AND.PRE.EQ.'000')FORM='(I1)'
	IF(NF.EQ.10.AND.PRE.EQ.'%%C')FORM='(A3,I1)'
	IF(NF.EQ.20.AND.PRE.EQ.'000')FORM='(I2)'
	IF(NF.EQ.20.AND.PRE.EQ.'%%C')FORM='(A3,I2)'
	IF(NF.EQ.30.AND.PRE.EQ.'000')FORM='(I3)'
	IF(NF.EQ.30.AND.PRE.EQ.'%%C')FORM='(A3,I3)'
	IF(NF.EQ.40.AND.PRE.EQ.'000')FORM='(I4)'
	IF(NF.EQ.40.AND.PRE.EQ.'%%C')FORM='(A3,I4)'
	IF(NF.EQ.11.AND.PRE.EQ.'000')FORM='(F3.1)'
	IF(NF.EQ.11.AND.PRE.EQ.'%%C')FORM='(A3,F3.1)'
	IF(NF.EQ.21.AND.PRE.EQ.'000')FORM='(F4.1)'
	IF(NF.EQ.21.AND.PRE.EQ.'%%C')FORM='(A3,F4.1)'
	IF(NF.EQ.31.AND.PRE.EQ.'000')FORM='(F5.1)'
	IF(NF.EQ.31.AND.PRE.EQ.'%%C')FORM='(A3,F5.1)'
	IF(NF.EQ.41.AND.PRE.EQ.'000')FORM='(F6.1)'
	IF(NF.EQ.41.AND.PRE.EQ.'%%C')FORM='(A3,F6.1)'
	IF(NF.EQ.12.AND.PRE.EQ.'000')FORM='(F4.2)'
	IF(NF.EQ.12.AND.PRE.EQ.'%%C')FORM='(A3,F4.2)'
	IF(NF.EQ.22.AND.PRE.EQ.'000')FORM='(F5.2)'
	IF(NF.EQ.22.AND.PRE.EQ.'%%C')FORM='(A3,F5.2)'
	IF(NF.EQ.32.AND.PRE.EQ.'000')FORM='(F6.2)'
	IF(NF.EQ.32.AND.PRE.EQ.'%%C')FORM='(A3,F6.2)'
	IF(NF.EQ.42.AND.PRE.EQ.'000')FORM='(F7.2)'
	IF(NF.EQ.42.AND.PRE.EQ.'%%C')FORM='(A3,F7.2)'
	IF(PRE.EQ.'000')THEN
	IF(NS.EQ.0)THEN
	WRITE(1,FORM)INT(TEXT+0.0001)
	ELSE
	WRITE(1,FORM)TEXT
	ENDIF
	ELSE
	IF(NS.EQ.0)THEN
	WRITE(1,FORM)PRE,INT(TEXT+0.0001)
	ELSE
	WRITE(1,FORM)PRE,TEXT
	ENDIF
	ENDIF
	WRITE(1,'(A)')'EXIT'
	RETURN
	END
	

	SUBROUTINE FRQ(Y0,LR,OUTR,ZO,Q,ZOI,ZOJ,Y,DC,IO,II,IJ,YY,DY)
	DIMENSION ZO(30),Q(30,3),OUTR(30,13)
	CHARACTER*1 LR
	SPACE=AMAX1(10.,DC/60.)
	IF(LR.EQ.'R')THEN
	ZL=8
	ZR=35
	ELSEIF(LR.EQ.'L')THEN
	ZL=35
	ZR=8
	ENDIF
	YY=Y+DY
	IF(II.GT.IJ)IJ1=II
  10	YY=YY-DY
	DO 20 I=1,IO+1
	IF(I.NE.II.AND.I.NE.IJ1)THEN
	IF((Q(I,1)+SPACE).GE.YY.AND.(Q(I,1)-SPACE).LE.YY)THEN
	IF((ZOI-ZO(I)).GE.0)THEN
	IF((ZOI-ZO(I)-Q(I,3)).LT.ZL)GOTO 10
	ELSE
	IF((ZO(I)-ZOJ-Q(I,2)).LT.ZR)GOTO 10
	ENDIF
	ENDIF
	IF(I.EQ.1)THEN
	IF(DY.GT.0)THEN
	YMIN=Y0-OUTR(I,1)/2-SPACE
	YMAX=Y0-OUTR(I,1)/2
	ELSEIF(DY.LT.0)THEN
	YMIN=Y0+OUTR(I,1)/2
	YMAX=Y0+OUTR(I,1)/2+SPACE
	ENDIF
	ELSEIF(I.EQ.IO+1)THEN
	IF(DY.GT.0)THEN
	YMIN=Y0-OUTR(I-1,1)/2-SPACE
	YMAX=Y0-OUTR(I-1,1)/2
	ELSEIF(DY.LT.0)THEN
	YMIN=Y0+OUTR(I-1,1)/2
	YMAX=Y0+OUTR(I-1,1)/2+SPACE
	ENDIF
	ELSE
	IF(DY.GT.0.)THEN
	YMIN=AMIN1(Y0-OUTR(I-1,2)/2,Y0-OUTR(I,1)/2)-SPACE
	YMAX=AMAX1(Y0-OUTR(I-1,2)/2,Y0-OUTR(I,1)/2)
	ELSEIF(DY.LT.0.)THEN
	YMIN=AMIN1(Y0+OUTR(I-1,2)/2,Y0+OUTR(I,1)/2)
	YMAX=AMAX1(Y0+OUTR(I-1,2)/2,Y0+OUTR(I,1)/2)+SPACE
	ENDIF
	ENDIF
	IF(YMAX.GE.YY.AND.YMIN.LE.YY)THEN
	IF((ZOI-ZO(I)).GE.0)THEN
	IF((ZOI-ZO(I)).LT.ZL)GOTO 10
	ELSE
	IF((ZO(I)-ZOJ).LT.ZR)GOTO 10
	ENDIF
	ENDIF
	ENDIF
  20	CONTINUE
	RETURN
	END

	SUBROUTINE DIMG(X,Y,ANGL,DGL,PRE)
	DIMENSION X(50),Y(50)
	CHARACTER*1 ANG,DG
	CHARACTER*3 PRE
	WRITE(1,'(A)')'DIM'
	WRITE(1,'(A)')'DIMTAD'
	WRITE(1,'(A)')'OFF'
	WRITE(1,'(A)')'ROTATED'
	WRITE(1,'(E12.7)')0.
	WRITE(1,'(E12.7,A1,E12.7)')X(1),',',Y(1)
	WRITE(1,'(E12.7,A1,E12.7)')X(2),',',Y(2)
	WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)
	IF(FLOAT(INT(ANGL)).EQ.ANGL)THEN
	IA=INT(ANGL)
	ANG='I'
	ELSE
	ANG='F'
	ENDIF
	IF(FLOAT(INT(DGL)).EQ.DGL)THEN
	ID=INT(DGL)
	DG='I'
	ELSE
	DG='F'
	ENDIF
	IF(ANG.EQ.'I'.AND.DG.EQ.'I')THEN
	IF(IA.GE.10.AND.ID.GE.10)THEN
	WRITE(1,'(I2,A1,I2,A3)')ID,'X',IA,PRE
	ELSEIF(IA.LT.10.AND.ID.GE.10)THEN
	WRITE(1,'(I2,A1,I1,A3)')ID,'X',IA,PRE
	ELSEIF(IA.GE.10.AND.ID.LT.10)THEN
	WRITE(1,'(I1,A1,I2,A3)')ID,'X',IA,PRE
	ELSEIF(IA.LT.10.AND.ID.LT.10)THEN
	WRITE(1,'(I1,A1,I1,A3)')ID,'X',IA,PRE
	ENDIF
	ELSEIF(ANG.EQ.'I'.AND.DG.EQ.'F')THEN
	IF(IA.GE.10.AND.DGL.GE.10.)THEN
	WRITE(1,'(F4.1,A1,I2,A3)')DGL,'X',IA,PRE
	ELSEIF(IA.LT.10.AND.DGL.GE.10.)THEN
	WRITE(1,'(F4.1,A1,I1,A3)')DGL,'X',IA,PRE
	ELSEIF(IA.GE.10.AND.DGL.LT.10..AND.DGL.GE.1.)THEN
	WRITE(1,'(F3.1,A1,I2,A3)')DGL,'X',IA,PRE
	ELSEIF(IA.LT.10.AND.DGL.LT.10..AND.DGL.GE.1.)THEN
	WRITE(1,'(F3.1,A1,I1,A3)')DGL,'X',IA,PRE
	ELSEIF(IA.GE.10.AND.DGL.LT.1.)THEN
	WRITE(1,'(A1,F2.1,A1,I2,A3)')'0',DGL,'X',IA,PRE
	ELSEIF(IA.LT.10.AND.DGL.LT.1.)THEN
	WRITE(1,'(A1,F2.1,A1,I1,A3)')'0',DGL,'X',IA,PRE
	ENDIF
	ELSEIF(ANG.EQ.'F'.AND.DG.EQ.'I')THEN
	IF(ANGL.GE.10..AND.ID.GE.10)THEN
	WRITE(1,'(I2,A1,F4.1,A3)')ID,'X',ANGL,PRE
	ELSEIF(ANGL.LT.10..AND.ANGL.GE.1..AND.ID.GE.10)THEN
	WRITE(1,'(I2,A1,F3.1,A3)')ID,'X',ANGL,PRE
	ELSEIF(ANGL.GE.10..AND.ID.LT.10)THEN
	WRITE(1,'(I1,A1,F4.1,A3)')ID,'X',ANGL,PRE
	ELSEIF(ANGL.LT.10..AND.ANGL.GE.1..AND.ID.LT.10)THEN
	WRITE(1,'(I1,A1,F3.1,A3)')ID,'X',ANGL,PRE
	ELSEIF(ANGL.LT.1..AND.ID.GE.10)THEN
	WRITE(1,'(I2,A2,F2.1,A3)')ID,'X0',ANGL,PRE
	ELSEIF(ANGL.LT.1..AND.ID.LT.10)THEN
	WRITE(1,'(I1,A2,F2.1,A3)')ID,'X0',ANGL,PRE
	ENDIF
	ELSEIF(ANG.EQ.'F'.AND.DG.EQ.'F')THEN
	IF(ANGL.GE.10..AND.DGL.GE.10.)THEN
	WRITE(1,'(F4.1,A1,F4.1,A3)')DGL,'X',ANGL,PRE
	ELSEIF(ANGL.LT.10..AND.ANGL.GE.1..AND.DGL.GE.10.)THEN
	WRITE(1,'(F4.1,A1,F3.1,A3)')DGL,'X',ANGL,PRE
	ELSEIF(ANGL.GE.10..AND.DGL.LT.10..AND.DGL.GE.1.)THEN
	WRITE(1,'(F3.1,A1,F4.1,A3)')DGL,'X',ANGL,PRE
	ELSEIF(ANGL.LT.10..AND.ANGL.GE.1..AND.DGL.LT.10..AND.DGL.GE.1.)
     #	THEN
	WRITE(1,'(F3.1,A1,F3.1,A3)')DGL,'X',ANGL,PRE
	ELSEIF(ANGL.GE.10..AND.DGL.LT.1.)THEN
	WRITE(1,'(A1,F2.1,A1,F4.1,A3)')'0',DGL,'X',ANGL,PRE
	ELSEIF(ANGL.LT.10..AND.ANGL.GE.1..AND.DGL.LT.1.)THEN
	WRITE(1,'(A1,F2.1,A1,F3.1,A3)')'0',DGL,'X',ANGL,PRE
	ELSEIF(ANGL.LT.1..AND.DGL.GE.10.)THEN
	WRITE(1,'(F4.1,A2,F2.1,A3)')DGL,'X0',ANGL,PRE
	ELSEIF(ANGL.LT.1..AND.DGL.LT.10..AND.DGL.GE.1.)THEN
	WRITE(1,'(F3.1,A2,F2.1,A3)')DGL,'X0',ANGL,PRE
	ENDIF
	ENDIF
	WRITE(1,'(A)')'DIMTAD'
	WRITE(1,'(A)')'ON'
	WRITE(1,'(A)')'EXIT'
	RETURN
	END

	SUBROUTINE BLANK(P,II,K,ZH,CONS,XMIN,XMAX,DX)
	DIMENSION ZH(30),CONS(100,2),SEQ(100,2)
	CHARACTER*2 P
	N=0
	DO 10 I=1,K
	IF(CONS(I,2).GE.ZH(II).AND.CONS(I,1).LE.ZH(II+1))THEN
	N=N+1
	SEQ(N,1)=CONS(I,1)
	SEQ(N,2)=CONS(I,2)
	ENDIF
  10	CONTINUE
	DO 15 I=1,N
	DO 15 J=I+1,N
	IF(SEQ(I,1).EQ.0.OR.SEQ(J,1).EQ.0) GOTO 15
	IF(AMAX1(ABS(SEQ(I,2)-SEQ(J,1)),ABS(SEQ(I,1)-SEQ(J,2)))-(ABS(
     #	SEQ(I,1)-SEQ(I,2))+ABS(SEQ(J,1)-SEQ(J,2))).LT.16..OR.(SEQ(I,2)
     #	.GE.SEQ(J,1).AND.SEQ(J,2).GE.SEQ(I,1)))THEN
	SEQ(I,1)=AMIN1(SEQ(I,1),SEQ(J,1))
	SEQ(I,2)=AMAX1(SEQ(I,2),SEQ(J,2))
	SEQ(J,1)=0
	SEQ(J,2)=0
	ENDIF
  15	CONTINUE
	IF(N.EQ.0)GOTO 55
	KK=0
	DO 30 I=1,N
	CMIN=10000.
	JMIN=0
	DO 20 J=KK+1,N
	IF(SEQ(J,1).EQ.0.OR.SEQ(J,2).EQ.0)GOTO 20
	IF(SEQ(J,1).LT.CMIN)THEN
	CMIN=SEQ(J,1)
	JMIN=J
	ENDIF
  20	CONTINUE
	IF(JMIN.EQ.0)GOTO 30
	KK=KK+1
	CONS1=SEQ(KK,1)
	CONS2=SEQ(KK,2)
	SEQ(KK,1)=SEQ(JMIN,1)
	SEQ(KK,2)=SEQ(JMIN,2)
	SEQ(JMIN,1)=CONS1
	SEQ(JMIN,2)=CONS2
  30	CONTINUE
	IF(KK.GE.2)THEN
	IF(P.EQ.'->')THEN
	DO 40 I=1,KK-1
	IF((SEQ(I+1,1)-SEQ(I,2)).GE.16)THEN
	XMIN=SEQ(I,2)
	XMAX=SEQ(I+1,1)
	DX=XMAX-XMIN
	GOTO 60
	ENDIF
  40	CONTINUE
	ELSEIF(P.EQ.'<-')THEN
	DO 50 I=KK,2,-1
	IF((SEQ(I,1)-SEQ(I-1,2)).GE.16)THEN
	XMIN=SEQ(I-1,2)
	XMAX=SEQ(I,1)
	DX=XMAX-XMIN
	GOTO 60
	ENDIF
  50	CONTINUE
	ENDIF
	ENDIF
  55	XMIN=0
	XMAX=0
	DX=0
  60	RETURN
	END

	SUBROUTINE GEARP(DP,DP1,DO,DO1,BF,NZ1,NZ2,RM,RM1,A0,ALF,CSI,
     #	NGF,GFL,SX,CG,I)
	DIMENSION DP(5),DP1(5),DO(5),DO1(5),BF(5),BFW(5),NZ1(5)
	DIMENSION NZ2(5),RM(5),RM1(5),A(5),A0(5),ALF(5),CSI(5)
	DIMENSION NGF(5),GFL(5),SX(5),CG(5)
	REAL NZJ
	BFW(I)=BF(I)*0.017453292
	AF=ALF(I)*0.017453292
	AFS=ATAN(TAN(AF)/COS(BFW(I)))
	SMA=0.
	DP(I)=RM1(I)*NZ1(I)/COS(BFW(I))
	DP1(I)=DP(I)
	DO(I)=DP(I)+2*RM1(I)
	RM(I)=RM1(I)
        AC=(NZ1(I)+NZ2(I))*RM1(I)/2
	IF(A0(I).EQ.AC)THEN
	DO1(I)=DO(I)+2*CSI(I)*RM1(I)
	ELSEIF(A0(I).NE.AC)THEN
	A(I)=RM1(I)*(NZ1(I)+NZ2(I))/COS(BFW(I))/2
	RAMD0=(A0(I)-A(I))/A(I)
	IF(RAMD0.GT.0.)THEN
	AP=ACOS(COS(AF)/(1+RAMD0))
	ELSE
	AP=AF
	ENDIF
	EP0=(TAN(AP)-AP-TAN(AF)+AF)/TAN(AF)
	SMA0=EP0-RAMD0
	W=0
	IF(BF(I).NE.0..AND.RAMD0.GT.0.)THEN
	X=500.*RAMD0
	B=ALOG(1.332)+0.09768*ALOG(BF(I))
	B=EXP(B)
	W=ALOG(0.27E-07)+1.3123*ALOG(BF(I))+B*ALOG(X)
	W=EXP(W)
	ENDIF
	SMA=(NZ1(I)+NZ2(I))*(SMA0/2-W)
	DO1(I)=DO(I)+2*CSI(I)*RM1(I)-2*SMA*RM1(I)/COS(BFW(I))
	ENDIF
	AFS=ATAN(TAN(AF)/COS(BFW(I)))
	CSIS=CSI(I)*COS(BFW(I))
	NZJ=NZ1(I)*(TAN(AFS)-AFS)/(TAN(AF)-AF)
	GF=NZJ*ACOS((NZ1(I)*COS(AFS))/(NZ1(I)+2*CSIS))/
     #  3.14159+0.5
	NGF(I)=INT(GF+0.5)
	GFL(I)=RM1(I)*COS(AF)*((NGF(I)-0.5)*3.1415927+NZJ*(TAN(AF)-
     #  AF))+2*CSI(I)*RM1(I)*SIN(AF)
	SX(I)=RM1(I)*3.141593*COS(AF)*COS(AF)/2+CSI(I)*RM1(I)*SIN(2*AF)
	CG(I)=RM1(I)-RM1(I)*3.1415927*SIN(2*AF)/8+CSI(I)*RM1(I)*
     #  COS(AF)*COS(AF)-SMA*RM1(I)
	RETURN
	END

      SUBROUTINE CONGEARP(CM,CZ1,CZ2,CD,CDD,CDA,CR,CF,CG,CDDA,CDF,
     # CZD,CK1,CSX,CK2,CNX,I,OUTR,CGP,CP)
      DIMENSION OUTR(30,13),CGP(8,2)
      CD=CM*CZ1
      CDD=ATAN(CZ1/CZ2)
      CDA=CM*(CDD+2*COS(CDD))
      CR=CM*CZ1/(2*SIN(CDD))
      CF=ATAN(2*SIN(CDD)/CZ1)
      CG=ATAN(2.4*SIN(CDD)/CZ1)
      CDDA=CDD+CF
      CDF=CDD-CG
      CZD=CZ1/COS(CDD)
      CK1=CZD*SIN(1.5708/CZD)
      CSX=CM*CK1
      CK2=1+(CZD/2)*(1-COS(1.5708/CZD))
      CNX=CK2*CM
      CP1=CR-OUTR(I,5)
      CP2=CP1/COS(CDD-CDF)
      CP21=CP1/COS(CDDA-CDD)
      CP22=CR/COS(CDDA-CDD)
      CP3=OUTR(I,7)/TAN(CDD)
      CP6=COS(CDF)*CP2
      CP5=TAN(CDF)*CP6
      CP7=CR/COS(CDD-CDF)
      CP8=CP7*SIN(CDF)
      CP9=CP7*COS(CDF)
      CP=CP21*COS(CDDA)
      CP4=TAN(CDDA)*CP
      CP11=CR*COS(CDD)
      CP12=CR*SIN(CDD)
      CP13=OUTR(I,3)-(CP11-CP)
      CP14=CP13/TAN(CDD)
      CP15=CP12-CP14
      CP16=CP22*SIN(CDDA)
      CP17=CP22*COS(CDDA)
      CP18=CP6/TAN(CDDA)
      CP19=CP1*SIN(CDD)
      CP20=CP1*COS(CDD)
      CGP(1,1)=OUTR(I,7)
      CGP(1,2)=CP4-CP3
      CGP(2,1)=CP6-CP
      CGP(2,2)=CP5
      CGP(3,1)=CP20-CP
      CGP(3,2)=CP19
      CGP(4,1)=0
      CGP(4,2)=CP4
      CGP(5,1)=CP17-CP
      CGP(5,2)=CP16
      CGP(6,1)=CP11-CP
      CGP(6,2)=CP12
      CGP(7,1)=CP9-CP
      CGP(7,2)=CP8
      CGP(8,1)=OUTR(I,3)
      CGP(8,2)=CP15
      RETURN
      END

	SUBROUTINE WBP(WZ1,WZ2,WM,WQ,WA,WR,WD,WDA,WDF,WS1,WSM)
	INTEGER WZ1,WZ2
	WA=0.5*WM*(WQ+WZ2)
	WR=ATAN(WZ1/WQ)*180/3.14159
	WD=WQ*WM
	WDA=(WQ+2)*WM
	WDF=(WQ-2.4)*WM
	WS1=WM*1.5708
	WSM=WS1*COS(WR)
	RETURN
	END

	SUBROUTINE YML(Y3,Y0,IO,DC,OUTR,Q,BZ,ZO,ZH,I,J)
	DIMENSION OUTR(30,13),Q(30,3),ZO(30),ZH(30)
	CHARACTER*1 YN
	CHARACTER*2 BZ(30,30)
	YN='N'
	IF(DC.GT.0)THEN
	DO 5 I1=1,20
	DO 5 J1=I1,20
	IF(BZ(I1,J1).EQ.'* ')THEN
	IF((I1.GE.I.AND.J1.LT.J).OR.(I1.GT.I.AND.J1.LE.J))YN='Y'
	IF(OUTR(I1,13).NE.0.)YN='Y'
	ENDIF
   5	CONTINUE
	ENDIF
	DO 15 I2=I,J
  15	IF(OUTR(I2,1).NE.OUTR(I2,2))YN='Y'
	SPACE=AMAX1(10.,ABS(DC)/60)
	G=DC/ABS(DC)
	Y3=Y0
	IF(YN.EQ.'Y')THEN
	IF(G.GT.0.)THEN
	DO 20 II=I,J+1
	IF(Y3.LT.Q(II,1))Y3=Q(II,1)
  20	CONTINUE
	ELSEIF(G.LT.0.)THEN
	DO 30 II=I,J+1
	IF(Y3.GT.Q(II,1))Y3=Q(II,1)
  30	CONTINUE
	ENDIF
	ELSEIF(YN.EQ.'N')THEN
	DO 10 K1=I,J+1
	IF(K1.EQ.1)THEN
	Y3=Y0+G*OUTR(1,1)/2
	ELSEIF(K1.EQ.IO+1)THEN
	Y3=Y0+G*OUTR(IO,2)/2
	ELSE
	IF(G.GT.0)THEN
	Y3=AMAX1(Y3,Y0+OUTR(K1-1,2)/2,Y0+OUTR(K1,1)/2)
	ELSEIF(G.LT.0)THEN
	Y3=AMIN1(Y3,Y0-OUTR(K1-1,2)/2,Y0-OUTR(K1,1)/2)
	ENDIF
	ENDIF
  10	CONTINUE
	ENDIF
	Y3=Y3+SPACE*G
	RETURN
	END

	SUBROUTINE SCON(CONS,KK,XMIN,XMAX)
	DIMENSION CONS(100,2)
	KK=KK+1
	CONS(KK,1)=XMIN
	CONS(KK,2)=XMAX
	RETURN
	END
     
	SUBROUTINE CCIR(XC,YC,R)
	CALL CIR(XC,YC,R)
	CALL CIR(XC,YC,R-0.15)
	CALL CIR(XC,YC,R+0.15)
	RETURN
	END

        SUBROUTINE ARCA(XF,YF,XM,YM,ING)
        WRITE(1,'(A)')'ARC'
        WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
        WRITE(1,'(A)')'E'
        WRITE(1,'(E12.7,A1,E12.7)')XM,',',YM
        WRITE(1,'(A)')'A'
	IF(ING.GE.0)THEN
        WRITE(1,'(I2)')ING
	ELSE
	WRITE(1,'(A1,I2)')'-',ABS(ING)
	ENDIF
	RETURN
	END

        SUBROUTINE PLI1(XF,YF,XM,YM,XE,YE)
        WRITE(1,'(A)')'PLINE'
        WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
        WRITE(1,'(A)')'W'
        WRITE(1,'(E12.7,X)')0.35
        WRITE(1,'(A)')'A'
        WRITE(1,'(A)')'S'
        WRITE(1,'(E12.7,A1,E12.7)')XM,',',YM
        WRITE(1,'(E12.7,A1,E12.7,X)')XE,',',YE
        RETURN
        END

        SUBROUTINE PLI2(XF,YF,XE,YE,ING)
        WRITE(1,'(A)')'PLINE'
        WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
        WRITE(1,'(A)')'W'
        WRITE(1,'(E12.7,X)')0.35
        WRITE(1,'(A)')'A'
        WRITE(1,'(A)')'A'
        IF(ING.GE.0)THEN
        IF(ING.EQ.90)THEN
        WRITE(1,'(I2)')ING
        ELSE
        WRITE(1,'(I3)')ING
        ENDIF
        ELSE
        IF(ING.EQ.-90)THEN
        WRITE(1,'(A1,I2)')'-',ABS(ING)
        ELSE
        WRITE(1,'(A1,I3)')'-',ABS(ING)
        ENDIF
        ENDIF
        WRITE(1,'(E12.7,A1,E12.7,X)')XE,',',YE
        RETURN
        END

        SUBROUTINE ERA(X,Y,N)
        DIMENSION X(10),Y(10)
        WRITE(1,'(A)')'ERASE'
        DO 99 I=1,N-1
        WRITE(1,'(E12.7,A1,E12.7)')X(I),',',Y(I)
   99   CONTINUE
        WRITE(1,'(E12.7,A1,E12.7,X)')X(N),',',Y(N)
        RETURN
        END
