home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 6.ddi / OBJ / SUB.FOR < prev    next >
Encoding:
Text File  |  1990-03-19  |  17.8 KB  |  740 lines
  1. $DEBUG
  2.     SUBROUTINE LINE(XF,YF,XE,YE)
  3.     WRITE(1,'(A)')'LINE'
  4.     WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
  5.     WRITE(1,'(E12.7,A1,E12.7,X)')XE,',',YE
  6.     RETURN
  7.     END
  8.  
  9.     SUBROUTINE CLINE(X,Y,N,C)
  10.     CHARACTER*1 C
  11.     DIMENSION X(50),Y(50)
  12.     WRITE(1,'(A)')'LINE'
  13.     DO 10 I=1,N
  14.         WRITE(1,'(E12.7,A1,E12.7)')X(I),',',Y(I)
  15.   10    CONTINUE
  16.     IF(C.EQ.'0') THEN
  17.     WRITE(1,'(A)')'C'
  18.     ELSEIF(C.EQ.'1') THEN
  19.     WRITE(1,'(A3)')'   '
  20.     ENDIF
  21.     RETURN
  22.     END
  23.  
  24.     SUBROUTINE ARC3(XF,YF,XM,YM,XE,YE)
  25.     WRITE(1,'(A)')'ARC'
  26.     WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
  27.     WRITE(1,'(E12.7,A1,E12.7)')XM,',',YM
  28.     WRITE(1,'(E12.7,A1,E12.7)')XE,',',YE
  29.     RETURN
  30.     END
  31.  
  32.     SUBROUTINE CIR(XC,YC,R)
  33.     WRITE(1,'(A)')'CIRCLE'
  34.     WRITE(1,'(E12.7,A1,E12.7)')XC,',',YC
  35.     WRITE(1,'(E12.7)')R
  36.     RETURN
  37.     END
  38.  
  39.     SUBROUTINE TRACE(X,Y,N,B)
  40.     DIMENSION X(50),Y(50)
  41.     WRITE(1,'(A)')'TRACE'
  42.     WRITE(1,'(E12.7)')B
  43.     M=N-1
  44.     DO 10 I=1,M
  45.   10    WRITE(1,'(E12.7,A1,E12.7)')X(I),',',Y(I)
  46.     WRITE(1,'(E12.7,A1,E12.7,X)')X(N),',',Y(N)
  47.     RETURN
  48.     END
  49.  
  50.     SUBROUTINE TLINE(XF,YF,XE,YE,B)
  51.     WRITE(1,'(A)')'TRACE'
  52.     WRITE(1,'(E12.7)')B
  53.       WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
  54.     WRITE(1,'(E12.7,A1,E12.7,X)')XE,',',YE
  55.     RETURN
  56.     END
  57.  
  58.     SUBROUTINE INSERT(NAME,XB,YB,XSCL,YSCL,ANG)
  59.     CHARACTER*3 NAME
  60.     WRITE(1,'(A)')'INSERT'
  61.     WRITE(1,'(A12,A3)')'/HOUSEM/DWG/',NAME
  62.     WRITE(1,'(E12.7,A1,E12.7)')XB,',',YB
  63.     WRITE(1,'(E12.7)')XSCL
  64.     WRITE(1,'(E12.7)')YSCL
  65.     WRITE(1,'(E12.7)')ANG
  66.     RETURN
  67.     END
  68.  
  69.     SUBROUTINE LSET(LAYER)
  70.     CHARACTER*1 LAYER
  71.     WRITE(1,'(A)')'LAYER'
  72.     WRITE(1,'(A)')'SET'
  73.     WRITE(1,'(A)')LAYER
  74.     WRITE(1,'(A2)')'  '
  75.     RETURN
  76.     END
  77.  
  78.     SUBROUTINE HATCH(ANGLE,SPACE,XF,YF,XE,YE)
  79.     WRITE(1,'(A)')'HATCH'
  80.     WRITE(1,'(A)')'U'
  81.     WRITE(1,'(E12.7)')ANGLE
  82.     WRITE(1,'(E12.7)')SPACE
  83.     WRITE(1,'(A)')'N'
  84.     WRITE(1,'(A)')'W'
  85.     WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
  86.     WRITE(1,'(E12.7,A1,E12.7,X)')XE,',',YE
  87.     RETURN
  88.     END
  89.  
  90.     SUBROUTINE DIA(XD,YD,TEXT)
  91.     WRITE(1,'(A)')'DIAMETER'
  92.     WRITE(1,'(E12.7,A1,E12.7)')XD,',',YD
  93.     WRITE(1,'(A)')
  94.     WRITE(1,'(A)')
  95.     RETURN
  96.     END
  97.  
  98.     SUBROUTINE ANGU(X,Y,TEXT)
  99.     DIMENSION X(50),Y(50)
  100.         INTEGER TEXT1
  101.     CHARACTER*3 DU
  102.       TEXT1=ABS(TEXT)
  103.       DU='%%D'
  104.     WRITE(1,'(A)')'DIM'
  105.     WRITE(1,'(A)')'ANGULAR'
  106.     WRITE(1,'(E12.7,A1,E12.7)')X(1),',',Y(1)
  107.     WRITE(1,'(E12.7,A1,E12.7)')X(2),',',Y(2)
  108.     WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)
  109.     WRITE(1,'(I2,A3)')TEXT1,DU
  110.     WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)+3
  111.     WRITE(1,'(A)')'EXIT'
  112.     RETURN
  113.     END
  114.  
  115.     SUBROUTINE ANGU1(X,Y,TEXT,GCH)
  116.     DIMENSION X(50),Y(50)
  117.         INTEGER TEXT1,GCH
  118.     CHARACTER*3 DU
  119.       TEXT1=ABS(TEXT)
  120.       DU='%%D'
  121.     WRITE(1,'(A)')'DIM'
  122.     WRITE(1,'(A)')'ANGULAR'
  123.     WRITE(1,'(E12.7,A1,E12.7)')X(1),',',Y(1)
  124.     WRITE(1,'(E12.7,A1,E12.7)')X(2),',',Y(2)
  125.     WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)
  126.     WRITE(1,'(I2,A3,A1,I2,A3,A1)')TEXT1,DU,'(',GCH,DU,')'
  127.     WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)+3
  128.     WRITE(1,'(A)')'EXIT'
  129.     RETURN
  130.     END
  131.  
  132.     SUBROUTINE TEXT(SC,H,ANG,X,Y,TXTN,ITXT,TXTA,N,AN)
  133.     CHARACTER*1 SC,AN
  134.     CHARACTER*10 FORM
  135.     CHARACTER*12 TXTA
  136.     WRITE(1,'(A)')'TEXT'
  137.     IF(SC.EQ.'S') THEN
  138.     WRITE(1,'(A)')'S'
  139.     WRITE(1,'(A)')'STANDARD'
  140.     WRITE(1,'(E12.7,A1,E12.7)')X,',',Y
  141.     ELSEIF(SC.EQ.'R')THEN
  142.     WRITE(1,'(A)')'C'
  143.     WRITE(1,'(E12.7,A1,E12.7)')X,',',Y
  144.     ENDIF
  145.     WRITE(1,'(E12.7)')H
  146.     WRITE(1,'(E12.7)')ANG
  147.     IF(AN.EQ.'F')THEN
  148.     CALL DECIM(TXTN,ND,NS)
  149.     NF=ND+NS
  150.     IF(NF.EQ.10)FORM='(I1)'
  151.     IF(NF.EQ.20)FORM='(I2)'
  152.     IF(NF.EQ.30)FORM='(I3)'
  153.     IF(NF.EQ.40)FORM='(I4)'
  154.     IF(NF.EQ.11)FORM='(F3.1)'
  155.     IF(NF.EQ.21)FORM='(F4.1)'
  156.     IF(NF.EQ.31)FORM='(F5.1)'
  157.     IF(NF.EQ.41)FORM='(F6.1)'
  158.     IF(NF.EQ.12)FORM='(F4.2)'
  159.     IF(NF.EQ.22)FORM='(F5.2)'
  160.     IF(NF.EQ.32)FORM='(F6.2)'
  161.     IF(NF.EQ.42)FORM='(F7.2)'
  162.     IF(NF.EQ.13)FORM='(F5.3)'
  163.     IF(NF.EQ.23)FORM='(F6.3)'
  164.     IF(NF.EQ.33)FORM='(F7.3)'
  165.     IF(NF.EQ.43)FORM='(F8.3)'
  166.     IF(NS.EQ.0)THEN
  167.     WRITE(1,FORM)INT(TXTN+0.0001)
  168.     ELSE
  169.     IF(TXTN.GE.1)THEN
  170.     WRITE(1,FORM)TXTN
  171.     ELSE
  172.     IF(NS.EQ.1)THEN
  173.     IF(TXTN.GE.0.)THEN
  174.     WRITE(1,'(A1,F2.1)')'0',TXTN
  175.     ELSE
  176.     WRITE(1,'(A2,F2.1)')'-0',ABS(TXTN)
  177.     ENDIF
  178.     ELSEIF(NS.EQ.2)THEN
  179.     IF(TXTN.GE.0.)THEN
  180.     WRITE(1,'(A1,F3.2)')'0',TXTN
  181.     ELSE
  182.     WRITE(1,'(A2,F3.2)')'-0',ABS(TXTN)
  183.     ENDIF
  184.     ELSEIF(NS.EQ.3)THEN
  185.     IF(TXTN.GE.0.)THEN
  186.     WRITE(1,'(A1,F4.3)')'0',TXTN
  187.     ELSE
  188.     WRITE(1,'(A2,F4.3)')'-0',ABS(TXTN)
  189.     ENDIF
  190.     ENDIF
  191.     ENDIF
  192.     ENDIF
  193.     ELSEIF(AN.EQ.'I')THEN
  194.     CALL DECIM(FLOAT(ITXT),ND,NS)
  195.     IF(ND.EQ.10)FORM='(I1)'
  196.     IF(ND.EQ.20)FORM='(I2)'
  197.     IF(ND.EQ.30)FORM='(I3)'
  198.     IF(ND.EQ.40)FORM='(I4)'
  199.     WRITE(1,FORM)ITXT
  200.     ELSEIF(AN.EQ.'A')THEN
  201.     IF(N.EQ.1)FORM='(A1)'
  202.     IF(N.EQ.2)FORM='(A2)'
  203.     IF(N.EQ.3)FORM='(A3)'
  204.     IF(N.EQ.4)FORM='(A4)'
  205.     IF(N.EQ.5)FORM='(A5)'
  206.     IF(N.EQ.6)FORM='(A6)'
  207.     IF(N.EQ.7)FORM='(A7)'
  208.     IF(N.EQ.8)FORM='(A8)'
  209.     IF(N.EQ.9)FORM='(A9)'
  210.     IF(N.EQ.10)FORM='(A10)'
  211.     IF(N.EQ.11)FORM='(A11)'
  212.     IF(N.EQ.12)FORM='(A12)'
  213.     WRITE(1,FORM)TXTA
  214.     ENDIF
  215.     RETURN
  216.     END
  217.     
  218.     SUBROUTINE DIM(ANGLE,X,Y,PRE,TEXT)
  219.     DIMENSION X(50),Y(50)
  220.     CHARACTER*3 PRE
  221.     CHARACTER*10 FORM
  222.     COMMON SCL
  223.     WRITE(1,'(A)')'DIM'
  224.     WRITE(1,'(A)')'ROTATED'
  225.     WRITE(1,'(E12.7)')ANGLE
  226.     WRITE(1,'(E12.7,A1,E12.7)')X(1),',',Y(1)
  227.     WRITE(1,'(E12.7,A1,E12.7)')X(2),',',Y(2)
  228.     WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)
  229.     IF(PRE.EQ.'NOT')THEN
  230.     WRITE(1,'(X)')
  231.     WRITE(1,'(A)')'EXIT'
  232.     RETURN
  233.     ENDIF
  234.     CALL DECIM(TEXT,ND,NS)
  235.     NF=ND+NS
  236.     IF(NF.EQ.10.AND.PRE.EQ.'000')FORM='(I1)'
  237.     IF(NF.EQ.10.AND.PRE.EQ.'%%C')FORM='(A3,I1)'
  238.     IF(NF.EQ.20.AND.PRE.EQ.'000')FORM='(I2)'
  239.     IF(NF.EQ.20.AND.PRE.EQ.'%%C')FORM='(A3,I2)'
  240.     IF(NF.EQ.30.AND.PRE.EQ.'000')FORM='(I3)'
  241.     IF(NF.EQ.30.AND.PRE.EQ.'%%C')FORM='(A3,I3)'
  242.     IF(NF.EQ.40.AND.PRE.EQ.'000')FORM='(I4)'
  243.     IF(NF.EQ.40.AND.PRE.EQ.'%%C')FORM='(A3,I4)'
  244.     IF(NF.EQ.11.AND.PRE.EQ.'000')FORM='(F3.1)'
  245.     IF(NF.EQ.11.AND.PRE.EQ.'%%C')FORM='(A3,F3.1)'
  246.     IF(NF.EQ.21.AND.PRE.EQ.'000')FORM='(F4.1)'
  247.     IF(NF.EQ.21.AND.PRE.EQ.'%%C')FORM='(A3,F4.1)'
  248.     IF(NF.EQ.31.AND.PRE.EQ.'000')FORM='(F5.1)'
  249.     IF(NF.EQ.31.AND.PRE.EQ.'%%C')FORM='(A3,F5.1)'
  250.     IF(NF.EQ.41.AND.PRE.EQ.'000')FORM='(F6.1)'
  251.     IF(NF.EQ.41.AND.PRE.EQ.'%%C')FORM='(A3,F6.1)'
  252.     IF(NF.EQ.12.AND.PRE.EQ.'000')FORM='(F4.2)'
  253.     IF(NF.EQ.12.AND.PRE.EQ.'%%C')FORM='(A3,F4.2)'
  254.     IF(NF.EQ.22.AND.PRE.EQ.'000')FORM='(F5.2)'
  255.     IF(NF.EQ.22.AND.PRE.EQ.'%%C')FORM='(A3,F5.2)'
  256.     IF(NF.EQ.32.AND.PRE.EQ.'000')FORM='(F6.2)'
  257.     IF(NF.EQ.32.AND.PRE.EQ.'%%C')FORM='(A3,F6.2)'
  258.     IF(NF.EQ.42.AND.PRE.EQ.'000')FORM='(F7.2)'
  259.     IF(NF.EQ.42.AND.PRE.EQ.'%%C')FORM='(A3,F7.2)'
  260.     IF(PRE.EQ.'000')THEN
  261.     IF(NS.EQ.0)THEN
  262.     WRITE(1,FORM)INT(TEXT+0.0001)
  263.     ELSE
  264.     WRITE(1,FORM)TEXT
  265.     ENDIF
  266.     ELSE
  267.     IF(NS.EQ.0)THEN
  268.     WRITE(1,FORM)PRE,INT(TEXT+0.0001)
  269.     ELSE
  270.     WRITE(1,FORM)PRE,TEXT
  271.     ENDIF
  272.     ENDIF
  273.     WRITE(1,'(A)')'EXIT'
  274.     RETURN
  275.     END
  276.     
  277.  
  278.     SUBROUTINE FRQ(Y0,LR,OUTR,ZO,Q,ZOI,ZOJ,Y,DC,IO,II,IJ,YY,DY)
  279.     DIMENSION ZO(30),Q(30,3),OUTR(30,13)
  280.     CHARACTER*1 LR
  281.     SPACE=AMAX1(10.,DC/60.)
  282.     IF(LR.EQ.'R')THEN
  283.     ZL=8
  284.     ZR=35
  285.     ELSEIF(LR.EQ.'L')THEN
  286.     ZL=35
  287.     ZR=8
  288.     ENDIF
  289.     YY=Y+DY
  290.     IF(II.GT.IJ)IJ1=II
  291.   10    YY=YY-DY
  292.     DO 20 I=1,IO+1
  293.     IF(I.NE.II.AND.I.NE.IJ1)THEN
  294.     IF((Q(I,1)+SPACE).GE.YY.AND.(Q(I,1)-SPACE).LE.YY)THEN
  295.     IF((ZOI-ZO(I)).GE.0)THEN
  296.     IF((ZOI-ZO(I)-Q(I,3)).LT.ZL)GOTO 10
  297.     ELSE
  298.     IF((ZO(I)-ZOJ-Q(I,2)).LT.ZR)GOTO 10
  299.     ENDIF
  300.     ENDIF
  301.     IF(I.EQ.1)THEN
  302.     IF(DY.GT.0)THEN
  303.     YMIN=Y0-OUTR(I,1)/2-SPACE
  304.     YMAX=Y0-OUTR(I,1)/2
  305.     ELSEIF(DY.LT.0)THEN
  306.     YMIN=Y0+OUTR(I,1)/2
  307.     YMAX=Y0+OUTR(I,1)/2+SPACE
  308.     ENDIF
  309.     ELSEIF(I.EQ.IO+1)THEN
  310.     IF(DY.GT.0)THEN
  311.     YMIN=Y0-OUTR(I-1,1)/2-SPACE
  312.     YMAX=Y0-OUTR(I-1,1)/2
  313.     ELSEIF(DY.LT.0)THEN
  314.     YMIN=Y0+OUTR(I-1,1)/2
  315.     YMAX=Y0+OUTR(I-1,1)/2+SPACE
  316.     ENDIF
  317.     ELSE
  318.     IF(DY.GT.0.)THEN
  319.     YMIN=AMIN1(Y0-OUTR(I-1,2)/2,Y0-OUTR(I,1)/2)-SPACE
  320.     YMAX=AMAX1(Y0-OUTR(I-1,2)/2,Y0-OUTR(I,1)/2)
  321.     ELSEIF(DY.LT.0.)THEN
  322.     YMIN=AMIN1(Y0+OUTR(I-1,2)/2,Y0+OUTR(I,1)/2)
  323.     YMAX=AMAX1(Y0+OUTR(I-1,2)/2,Y0+OUTR(I,1)/2)+SPACE
  324.     ENDIF
  325.     ENDIF
  326.     IF(YMAX.GE.YY.AND.YMIN.LE.YY)THEN
  327.     IF((ZOI-ZO(I)).GE.0)THEN
  328.     IF((ZOI-ZO(I)).LT.ZL)GOTO 10
  329.     ELSE
  330.     IF((ZO(I)-ZOJ).LT.ZR)GOTO 10
  331.     ENDIF
  332.     ENDIF
  333.     ENDIF
  334.   20    CONTINUE
  335.     RETURN
  336.     END
  337.  
  338.     SUBROUTINE DIMG(X,Y,ANGL,DGL,PRE)
  339.     DIMENSION X(50),Y(50)
  340.     CHARACTER*1 ANG,DG
  341.     CHARACTER*3 PRE
  342.     WRITE(1,'(A)')'DIM'
  343.     WRITE(1,'(A)')'DIMTAD'
  344.     WRITE(1,'(A)')'OFF'
  345.     WRITE(1,'(A)')'ROTATED'
  346.     WRITE(1,'(E12.7)')0.
  347.     WRITE(1,'(E12.7,A1,E12.7)')X(1),',',Y(1)
  348.     WRITE(1,'(E12.7,A1,E12.7)')X(2),',',Y(2)
  349.     WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)
  350.     IF(FLOAT(INT(ANGL)).EQ.ANGL)THEN
  351.     IA=INT(ANGL)
  352.     ANG='I'
  353.     ELSE
  354.     ANG='F'
  355.     ENDIF
  356.     IF(FLOAT(INT(DGL)).EQ.DGL)THEN
  357.     ID=INT(DGL)
  358.     DG='I'
  359.     ELSE
  360.     DG='F'
  361.     ENDIF
  362.     IF(ANG.EQ.'I'.AND.DG.EQ.'I')THEN
  363.     IF(IA.GE.10.AND.ID.GE.10)THEN
  364.     WRITE(1,'(I2,A1,I2,A3)')ID,'X',IA,PRE
  365.     ELSEIF(IA.LT.10.AND.ID.GE.10)THEN
  366.     WRITE(1,'(I2,A1,I1,A3)')ID,'X',IA,PRE
  367.     ELSEIF(IA.GE.10.AND.ID.LT.10)THEN
  368.     WRITE(1,'(I1,A1,I2,A3)')ID,'X',IA,PRE
  369.     ELSEIF(IA.LT.10.AND.ID.LT.10)THEN
  370.     WRITE(1,'(I1,A1,I1,A3)')ID,'X',IA,PRE
  371.     ENDIF
  372.     ELSEIF(ANG.EQ.'I'.AND.DG.EQ.'F')THEN
  373.     IF(IA.GE.10.AND.DGL.GE.10.)THEN
  374.     WRITE(1,'(F4.1,A1,I2,A3)')DGL,'X',IA,PRE
  375.     ELSEIF(IA.LT.10.AND.DGL.GE.10.)THEN
  376.     WRITE(1,'(F4.1,A1,I1,A3)')DGL,'X',IA,PRE
  377.     ELSEIF(IA.GE.10.AND.DGL.LT.10..AND.DGL.GE.1.)THEN
  378.     WRITE(1,'(F3.1,A1,I2,A3)')DGL,'X',IA,PRE
  379.     ELSEIF(IA.LT.10.AND.DGL.LT.10..AND.DGL.GE.1.)THEN
  380.     WRITE(1,'(F3.1,A1,I1,A3)')DGL,'X',IA,PRE
  381.     ELSEIF(IA.GE.10.AND.DGL.LT.1.)THEN
  382.     WRITE(1,'(A1,F2.1,A1,I2,A3)')'0',DGL,'X',IA,PRE
  383.     ELSEIF(IA.LT.10.AND.DGL.LT.1.)THEN
  384.     WRITE(1,'(A1,F2.1,A1,I1,A3)')'0',DGL,'X',IA,PRE
  385.     ENDIF
  386.     ELSEIF(ANG.EQ.'F'.AND.DG.EQ.'I')THEN
  387.     IF(ANGL.GE.10..AND.ID.GE.10)THEN
  388.     WRITE(1,'(I2,A1,F4.1,A3)')ID,'X',ANGL,PRE
  389.     ELSEIF(ANGL.LT.10..AND.ANGL.GE.1..AND.ID.GE.10)THEN
  390.     WRITE(1,'(I2,A1,F3.1,A3)')ID,'X',ANGL,PRE
  391.     ELSEIF(ANGL.GE.10..AND.ID.LT.10)THEN
  392.     WRITE(1,'(I1,A1,F4.1,A3)')ID,'X',ANGL,PRE
  393.     ELSEIF(ANGL.LT.10..AND.ANGL.GE.1..AND.ID.LT.10)THEN
  394.     WRITE(1,'(I1,A1,F3.1,A3)')ID,'X',ANGL,PRE
  395.     ELSEIF(ANGL.LT.1..AND.ID.GE.10)THEN
  396.     WRITE(1,'(I2,A2,F2.1,A3)')ID,'X0',ANGL,PRE
  397.     ELSEIF(ANGL.LT.1..AND.ID.LT.10)THEN
  398.     WRITE(1,'(I1,A2,F2.1,A3)')ID,'X0',ANGL,PRE
  399.     ENDIF
  400.     ELSEIF(ANG.EQ.'F'.AND.DG.EQ.'F')THEN
  401.     IF(ANGL.GE.10..AND.DGL.GE.10.)THEN
  402.     WRITE(1,'(F4.1,A1,F4.1,A3)')DGL,'X',ANGL,PRE
  403.     ELSEIF(ANGL.LT.10..AND.ANGL.GE.1..AND.DGL.GE.10.)THEN
  404.     WRITE(1,'(F4.1,A1,F3.1,A3)')DGL,'X',ANGL,PRE
  405.     ELSEIF(ANGL.GE.10..AND.DGL.LT.10..AND.DGL.GE.1.)THEN
  406.     WRITE(1,'(F3.1,A1,F4.1,A3)')DGL,'X',ANGL,PRE
  407.     ELSEIF(ANGL.LT.10..AND.ANGL.GE.1..AND.DGL.LT.10..AND.DGL.GE.1.)
  408.      #    THEN
  409.     WRITE(1,'(F3.1,A1,F3.1,A3)')DGL,'X',ANGL,PRE
  410.     ELSEIF(ANGL.GE.10..AND.DGL.LT.1.)THEN
  411.     WRITE(1,'(A1,F2.1,A1,F4.1,A3)')'0',DGL,'X',ANGL,PRE
  412.     ELSEIF(ANGL.LT.10..AND.ANGL.GE.1..AND.DGL.LT.1.)THEN
  413.     WRITE(1,'(A1,F2.1,A1,F3.1,A3)')'0',DGL,'X',ANGL,PRE
  414.     ELSEIF(ANGL.LT.1..AND.DGL.GE.10.)THEN
  415.     WRITE(1,'(F4.1,A2,F2.1,A3)')DGL,'X0',ANGL,PRE
  416.     ELSEIF(ANGL.LT.1..AND.DGL.LT.10..AND.DGL.GE.1.)THEN
  417.     WRITE(1,'(F3.1,A2,F2.1,A3)')DGL,'X0',ANGL,PRE
  418.     ENDIF
  419.     ENDIF
  420.     WRITE(1,'(A)')'DIMTAD'
  421.     WRITE(1,'(A)')'ON'
  422.     WRITE(1,'(A)')'EXIT'
  423.     RETURN
  424.     END
  425.  
  426.     SUBROUTINE BLANK(P,II,K,ZH,CONS,XMIN,XMAX,DX)
  427.     DIMENSION ZH(30),CONS(100,2),SEQ(100,2)
  428.     CHARACTER*2 P
  429.     N=0
  430.     DO 10 I=1,K
  431.     IF(CONS(I,2).GE.ZH(II).AND.CONS(I,1).LE.ZH(II+1))THEN
  432.     N=N+1
  433.     SEQ(N,1)=CONS(I,1)
  434.     SEQ(N,2)=CONS(I,2)
  435.     ENDIF
  436.   10    CONTINUE
  437.     DO 15 I=1,N
  438.     DO 15 J=I+1,N
  439.     IF(SEQ(I,1).EQ.0.OR.SEQ(J,1).EQ.0) GOTO 15
  440.     IF(AMAX1(ABS(SEQ(I,2)-SEQ(J,1)),ABS(SEQ(I,1)-SEQ(J,2)))-(ABS(
  441.      #    SEQ(I,1)-SEQ(I,2))+ABS(SEQ(J,1)-SEQ(J,2))).LT.16..OR.(SEQ(I,2)
  442.      #    .GE.SEQ(J,1).AND.SEQ(J,2).GE.SEQ(I,1)))THEN
  443.     SEQ(I,1)=AMIN1(SEQ(I,1),SEQ(J,1))
  444.     SEQ(I,2)=AMAX1(SEQ(I,2),SEQ(J,2))
  445.     SEQ(J,1)=0
  446.     SEQ(J,2)=0
  447.     ENDIF
  448.   15    CONTINUE
  449.     IF(N.EQ.0)GOTO 55
  450.     KK=0
  451.     DO 30 I=1,N
  452.     CMIN=10000.
  453.     JMIN=0
  454.     DO 20 J=KK+1,N
  455.     IF(SEQ(J,1).EQ.0.OR.SEQ(J,2).EQ.0)GOTO 20
  456.     IF(SEQ(J,1).LT.CMIN)THEN
  457.     CMIN=SEQ(J,1)
  458.     JMIN=J
  459.     ENDIF
  460.   20    CONTINUE
  461.     IF(JMIN.EQ.0)GOTO 30
  462.     KK=KK+1
  463.     CONS1=SEQ(KK,1)
  464.     CONS2=SEQ(KK,2)
  465.     SEQ(KK,1)=SEQ(JMIN,1)
  466.     SEQ(KK,2)=SEQ(JMIN,2)
  467.     SEQ(JMIN,1)=CONS1
  468.     SEQ(JMIN,2)=CONS2
  469.   30    CONTINUE
  470.     IF(KK.GE.2)THEN
  471.     IF(P.EQ.'->')THEN
  472.     DO 40 I=1,KK-1
  473.     IF((SEQ(I+1,1)-SEQ(I,2)).GE.16)THEN
  474.     XMIN=SEQ(I,2)
  475.     XMAX=SEQ(I+1,1)
  476.     DX=XMAX-XMIN
  477.     GOTO 60
  478.     ENDIF
  479.   40    CONTINUE
  480.     ELSEIF(P.EQ.'<-')THEN
  481.     DO 50 I=KK,2,-1
  482.     IF((SEQ(I,1)-SEQ(I-1,2)).GE.16)THEN
  483.     XMIN=SEQ(I-1,2)
  484.     XMAX=SEQ(I,1)
  485.     DX=XMAX-XMIN
  486.     GOTO 60
  487.     ENDIF
  488.   50    CONTINUE
  489.     ENDIF
  490.     ENDIF
  491.   55    XMIN=0
  492.     XMAX=0
  493.     DX=0
  494.   60    RETURN
  495.     END
  496.  
  497.     SUBROUTINE GEARP(DP,DP1,DO,DO1,BF,NZ1,NZ2,RM,RM1,A0,ALF,CSI,
  498.      #    NGF,GFL,SX,CG,I)
  499.     DIMENSION DP(5),DP1(5),DO(5),DO1(5),BF(5),BFW(5),NZ1(5)
  500.     DIMENSION NZ2(5),RM(5),RM1(5),A(5),A0(5),ALF(5),CSI(5)
  501.     DIMENSION NGF(5),GFL(5),SX(5),CG(5)
  502.     REAL NZJ
  503.     BFW(I)=BF(I)*0.017453292
  504.     AF=ALF(I)*0.017453292
  505.     AFS=ATAN(TAN(AF)/COS(BFW(I)))
  506.     SMA=0.
  507.     DP(I)=RM1(I)*NZ1(I)/COS(BFW(I))
  508.     DP1(I)=DP(I)
  509.     DO(I)=DP(I)+2*RM1(I)
  510.     RM(I)=RM1(I)
  511.         AC=(NZ1(I)+NZ2(I))*RM1(I)/2
  512.     IF(A0(I).EQ.AC)THEN
  513.     DO1(I)=DO(I)+2*CSI(I)*RM1(I)
  514.     ELSEIF(A0(I).NE.AC)THEN
  515.     A(I)=RM1(I)*(NZ1(I)+NZ2(I))/COS(BFW(I))/2
  516.     RAMD0=(A0(I)-A(I))/A(I)
  517.     IF(RAMD0.GT.0.)THEN
  518.     AP=ACOS(COS(AF)/(1+RAMD0))
  519.     ELSE
  520.     AP=AF
  521.     ENDIF
  522.     EP0=(TAN(AP)-AP-TAN(AF)+AF)/TAN(AF)
  523.     SMA0=EP0-RAMD0
  524.     W=0
  525.     IF(BF(I).NE.0..AND.RAMD0.GT.0.)THEN
  526.     X=500.*RAMD0
  527.     B=ALOG(1.332)+0.09768*ALOG(BF(I))
  528.     B=EXP(B)
  529.     W=ALOG(0.27E-07)+1.3123*ALOG(BF(I))+B*ALOG(X)
  530.     W=EXP(W)
  531.     ENDIF
  532.     SMA=(NZ1(I)+NZ2(I))*(SMA0/2-W)
  533.     DO1(I)=DO(I)+2*CSI(I)*RM1(I)-2*SMA*RM1(I)/COS(BFW(I))
  534.     ENDIF
  535.     AFS=ATAN(TAN(AF)/COS(BFW(I)))
  536.     CSIS=CSI(I)*COS(BFW(I))
  537.     NZJ=NZ1(I)*(TAN(AFS)-AFS)/(TAN(AF)-AF)
  538.     GF=NZJ*ACOS((NZ1(I)*COS(AFS))/(NZ1(I)+2*CSIS))/
  539.      #  3.14159+0.5
  540.     NGF(I)=INT(GF+0.5)
  541.     GFL(I)=RM1(I)*COS(AF)*((NGF(I)-0.5)*3.1415927+NZJ*(TAN(AF)-
  542.      #  AF))+2*CSI(I)*RM1(I)*SIN(AF)
  543.     SX(I)=RM1(I)*3.141593*COS(AF)*COS(AF)/2+CSI(I)*RM1(I)*SIN(2*AF)
  544.     CG(I)=RM1(I)-RM1(I)*3.1415927*SIN(2*AF)/8+CSI(I)*RM1(I)*
  545.      #  COS(AF)*COS(AF)-SMA*RM1(I)
  546.     RETURN
  547.     END
  548.  
  549.       SUBROUTINE CONGEARP(CM,CZ1,CZ2,CD,CDD,CDA,CR,CF,CG,CDDA,CDF,
  550.      # CZD,CK1,CSX,CK2,CNX,I,OUTR,CGP,CP)
  551.       DIMENSION OUTR(30,13),CGP(8,2)
  552.       CD=CM*CZ1
  553.       CDD=ATAN(CZ1/CZ2)
  554.       CDA=CM*(CDD+2*COS(CDD))
  555.       CR=CM*CZ1/(2*SIN(CDD))
  556.       CF=ATAN(2*SIN(CDD)/CZ1)
  557.       CG=ATAN(2.4*SIN(CDD)/CZ1)
  558.       CDDA=CDD+CF
  559.       CDF=CDD-CG
  560.       CZD=CZ1/COS(CDD)
  561.       CK1=CZD*SIN(1.5708/CZD)
  562.       CSX=CM*CK1
  563.       CK2=1+(CZD/2)*(1-COS(1.5708/CZD))
  564.       CNX=CK2*CM
  565.       CP1=CR-OUTR(I,5)
  566.       CP2=CP1/COS(CDD-CDF)
  567.       CP21=CP1/COS(CDDA-CDD)
  568.       CP22=CR/COS(CDDA-CDD)
  569.       CP3=OUTR(I,7)/TAN(CDD)
  570.       CP6=COS(CDF)*CP2
  571.       CP5=TAN(CDF)*CP6
  572.       CP7=CR/COS(CDD-CDF)
  573.       CP8=CP7*SIN(CDF)
  574.       CP9=CP7*COS(CDF)
  575.       CP=CP21*COS(CDDA)
  576.       CP4=TAN(CDDA)*CP
  577.       CP11=CR*COS(CDD)
  578.       CP12=CR*SIN(CDD)
  579.       CP13=OUTR(I,3)-(CP11-CP)
  580.       CP14=CP13/TAN(CDD)
  581.       CP15=CP12-CP14
  582.       CP16=CP22*SIN(CDDA)
  583.       CP17=CP22*COS(CDDA)
  584.       CP18=CP6/TAN(CDDA)
  585.       CP19=CP1*SIN(CDD)
  586.       CP20=CP1*COS(CDD)
  587.       CGP(1,1)=OUTR(I,7)
  588.       CGP(1,2)=CP4-CP3
  589.       CGP(2,1)=CP6-CP
  590.       CGP(2,2)=CP5
  591.       CGP(3,1)=CP20-CP
  592.       CGP(3,2)=CP19
  593.       CGP(4,1)=0
  594.       CGP(4,2)=CP4
  595.       CGP(5,1)=CP17-CP
  596.       CGP(5,2)=CP16
  597.       CGP(6,1)=CP11-CP
  598.       CGP(6,2)=CP12
  599.       CGP(7,1)=CP9-CP
  600.       CGP(7,2)=CP8
  601.       CGP(8,1)=OUTR(I,3)
  602.       CGP(8,2)=CP15
  603.       RETURN
  604.       END
  605.  
  606.     SUBROUTINE WBP(WZ1,WZ2,WM,WQ,WA,WR,WD,WDA,WDF,WS1,WSM)
  607.     INTEGER WZ1,WZ2
  608.     WA=0.5*WM*(WQ+WZ2)
  609.     WR=ATAN(WZ1/WQ)*180/3.14159
  610.     WD=WQ*WM
  611.     WDA=(WQ+2)*WM
  612.     WDF=(WQ-2.4)*WM
  613.     WS1=WM*1.5708
  614.     WSM=WS1*COS(WR)
  615.     RETURN
  616.     END
  617.  
  618.     SUBROUTINE YML(Y3,Y0,IO,DC,OUTR,Q,BZ,ZO,ZH,I,J)
  619.     DIMENSION OUTR(30,13),Q(30,3),ZO(30),ZH(30)
  620.     CHARACTER*1 YN
  621.     CHARACTER*2 BZ(30,30)
  622.     YN='N'
  623.     IF(DC.GT.0)THEN
  624.     DO 5 I1=1,20
  625.     DO 5 J1=I1,20
  626.     IF(BZ(I1,J1).EQ.'* ')THEN
  627.     IF((I1.GE.I.AND.J1.LT.J).OR.(I1.GT.I.AND.J1.LE.J))YN='Y'
  628.     IF(OUTR(I1,13).NE.0.)YN='Y'
  629.     ENDIF
  630.    5    CONTINUE
  631.     ENDIF
  632.     DO 15 I2=I,J
  633.   15    IF(OUTR(I2,1).NE.OUTR(I2,2))YN='Y'
  634.     SPACE=AMAX1(10.,ABS(DC)/60)
  635.     G=DC/ABS(DC)
  636.     Y3=Y0
  637.     IF(YN.EQ.'Y')THEN
  638.     IF(G.GT.0.)THEN
  639.     DO 20 II=I,J+1
  640.     IF(Y3.LT.Q(II,1))Y3=Q(II,1)
  641.   20    CONTINUE
  642.     ELSEIF(G.LT.0.)THEN
  643.     DO 30 II=I,J+1
  644.     IF(Y3.GT.Q(II,1))Y3=Q(II,1)
  645.   30    CONTINUE
  646.     ENDIF
  647.     ELSEIF(YN.EQ.'N')THEN
  648.     DO 10 K1=I,J+1
  649.     IF(K1.EQ.1)THEN
  650.     Y3=Y0+G*OUTR(1,1)/2
  651.     ELSEIF(K1.EQ.IO+1)THEN
  652.     Y3=Y0+G*OUTR(IO,2)/2
  653.     ELSE
  654.     IF(G.GT.0)THEN
  655.     Y3=AMAX1(Y3,Y0+OUTR(K1-1,2)/2,Y0+OUTR(K1,1)/2)
  656.     ELSEIF(G.LT.0)THEN
  657.     Y3=AMIN1(Y3,Y0-OUTR(K1-1,2)/2,Y0-OUTR(K1,1)/2)
  658.     ENDIF
  659.     ENDIF
  660.   10    CONTINUE
  661.     ENDIF
  662.     Y3=Y3+SPACE*G
  663.     RETURN
  664.     END
  665.  
  666.     SUBROUTINE SCON(CONS,KK,XMIN,XMAX)
  667.     DIMENSION CONS(100,2)
  668.     KK=KK+1
  669.     CONS(KK,1)=XMIN
  670.     CONS(KK,2)=XMAX
  671.     RETURN
  672.     END
  673.      
  674.     SUBROUTINE CCIR(XC,YC,R)
  675.     CALL CIR(XC,YC,R)
  676.     CALL CIR(XC,YC,R-0.15)
  677.     CALL CIR(XC,YC,R+0.15)
  678.     RETURN
  679.     END
  680.  
  681.         SUBROUTINE ARCA(XF,YF,XM,YM,ING)
  682.         WRITE(1,'(A)')'ARC'
  683.         WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
  684.         WRITE(1,'(A)')'E'
  685.         WRITE(1,'(E12.7,A1,E12.7)')XM,',',YM
  686.         WRITE(1,'(A)')'A'
  687.     IF(ING.GE.0)THEN
  688.         WRITE(1,'(I2)')ING
  689.     ELSE
  690.     WRITE(1,'(A1,I2)')'-',ABS(ING)
  691.     ENDIF
  692.     RETURN
  693.     END
  694.  
  695.         SUBROUTINE PLI1(XF,YF,XM,YM,XE,YE)
  696.         WRITE(1,'(A)')'PLINE'
  697.         WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
  698.         WRITE(1,'(A)')'W'
  699.         WRITE(1,'(E12.7,X)')0.35
  700.         WRITE(1,'(A)')'A'
  701.         WRITE(1,'(A)')'S'
  702.         WRITE(1,'(E12.7,A1,E12.7)')XM,',',YM
  703.         WRITE(1,'(E12.7,A1,E12.7,X)')XE,',',YE
  704.         RETURN
  705.         END
  706.  
  707.         SUBROUTINE PLI2(XF,YF,XE,YE,ING)
  708.         WRITE(1,'(A)')'PLINE'
  709.         WRITE(1,'(E12.7,A1,E12.7)')XF,',',YF
  710.         WRITE(1,'(A)')'W'
  711.         WRITE(1,'(E12.7,X)')0.35
  712.         WRITE(1,'(A)')'A'
  713.         WRITE(1,'(A)')'A'
  714.         IF(ING.GE.0)THEN
  715.         IF(ING.EQ.90)THEN
  716.         WRITE(1,'(I2)')ING
  717.         ELSE
  718.         WRITE(1,'(I3)')ING
  719.         ENDIF
  720.         ELSE
  721.         IF(ING.EQ.-90)THEN
  722.         WRITE(1,'(A1,I2)')'-',ABS(ING)
  723.         ELSE
  724.         WRITE(1,'(A1,I3)')'-',ABS(ING)
  725.         ENDIF
  726.         ENDIF
  727.         WRITE(1,'(E12.7,A1,E12.7,X)')XE,',',YE
  728.         RETURN
  729.         END
  730.  
  731.         SUBROUTINE ERA(X,Y,N)
  732.         DIMENSION X(10),Y(10)
  733.         WRITE(1,'(A)')'ERASE'
  734.         DO 99 I=1,N-1
  735.         WRITE(1,'(E12.7,A1,E12.7)')X(I),',',Y(I)
  736.    99   CONTINUE
  737.         WRITE(1,'(E12.7,A1,E12.7,X)')X(N),',',Y(N)
  738.         RETURN
  739.         END
  740.