home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p190 / 6.ddi / OBJ / SUB1.FOR < prev    next >
Encoding:
Text File  |  1990-04-22  |  15.6 KB  |  704 lines
  1. $DEBUG
  2.     SUBROUTINE DIMGCH(X,Y,H,TXT,SCH,XCH,ANGLE,PRE,FOL)
  3.     DIMENSION X(50),Y(50)
  4.     CHARACTER*1 NOC
  5.     CHARACTER*3 PRE
  6.     CHARACTER*5 FOL
  7.     COMMON SCL,NOC
  8.     IF(ANGLE.NE.90.)THEN
  9.     ANG1=ANGLE*3.14159/180.0
  10.     TANG=TAN(ANG1)
  11.     X1=(TANG*(Y(1)-Y(3))+X(1)+X(3)*TANG*TANG)/(1+TANG*TANG)
  12.     Y1=X1*TANG+Y(3)-X(3)*TANG
  13.     X2=(TANG*(Y(2)-Y(3))+X(2)+X(3)*TANG*TANG)/(1+TANG*TANG)
  14.     Y2=X2*TANG+Y(3)-X(3)*TANG
  15.     ELSE
  16.     ANG1=1.5708
  17.     X1=X(3)
  18.     X2=X(3)
  19.     Y1=Y(1)
  20.     Y2=Y(2)
  21.     ENDIF
  22.     CALL DECIM(TXT,ND,NS)
  23.     WRITE(1,'(A)')'DIM'
  24.     WRITE(1,'(A)')'ROTATED'
  25.     WRITE(1,'(E12.7)')ANGLE
  26.     WRITE(1,'(E12.7,A1,E12.7)')X(1),',',Y(1)
  27.     WRITE(1,'(E12.7,A1,E12.7)')X(2),',',Y(2)
  28.     WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)
  29.     WRITE(1,'(X)')
  30.     WRITE(1,'(A)')'EXIT'
  31.     IF(NS.EQ.0)THEN
  32.     ZL1=(ND/10+1.2)*H
  33.     ELSE
  34.     ZL1=(ND/10+NS+1.53)*H
  35.     ENDIF
  36.     IF(PRE.EQ.'000')ZL1=ZL1-1.2*H
  37.     IF(NOC.EQ.'C')THEN
  38.     ZL=ZL1
  39.     ELSE
  40.     IF(SCH.EQ.0..AND.XCH.EQ.0.)THEN
  41.     ND=0
  42.     NS=0
  43.     ELSE
  44.     CALL DECIM(SCH,NDS,NSS)
  45.     CALL DECIM(XCH,NDX,NSX)
  46.     ND=MAX0(NDS,NDX)
  47.     NS=MAX0(NSS,NSX)
  48.     ENDIF
  49.     IF(SCH.NE.0..OR.XCH.NE.0.)THEN
  50.     IF(NS.EQ.0)THEN
  51.     ZL=ZL1+(0.8+0.6)*H
  52.     ELSE
  53.     ZL=ZL1+(1.0+0.6*(1+NS))*H
  54.     ENDIF
  55.     ELSE
  56.     ZL=ZL1
  57.     ENDIF
  58.     ENDIF
  59.     IF(TXT/SCL.LT.25)THEN
  60.     CALL LINE(X1,Y1,X2,Y2)
  61.     ENDIF
  62.     IF(NOC.EQ.'C'.AND.FOL.NE.'     ')ZL=ZL1+3.4*H
  63.     IF((TXT/SCL-ZL).GE.8.0)THEN
  64.     XL=(X1+X2)/2.0-ZL*COS(ANG1)/2.0-H*SIN(ANG1)*0.5
  65.     YL=(Y1+Y2)/2.0-ZL*SIN(ANG1)/2.0+H*COS(ANG1)*0.5
  66.     ELSE
  67.     IF(TXT/SCL.LT.24.5)XXX=9.
  68.     IF(TXT/SCL.GE.24.5)XXX=2.
  69.     IF((X1.LE.X2.AND.Y1.LE.Y2).OR.(X1.LT.X2.AND.Y1.GE.Y2))THEN
  70.     XL=X2+XXX*COS(ANG1)+H*SIN(ANG1)/2.0
  71.     YL=Y2+XXX*SIN(ANG1)-H*COS(ANG1)/2.0
  72.     ELSE
  73.     XL=X2-(XXX+ZL)*COS(ANG1)+H*SIN(ANG1)/2.0
  74.     YL=Y2-(XXX+ZL)*SIN(ANG1)-H*COS(ANG1)/2.0
  75.     ENDIF
  76.     ENDIF
  77.     H1=0.6*H
  78.     XL1=XL
  79.     YL1=YL
  80.     IF(PRE.EQ.'%%C')THEN
  81.     CALL TEXT('S',H,ANGLE,XL1,YL1,0.0,0,'%%c',3,'A')
  82.     XL1=XL+1.2*H*COS(ANG1)
  83.     YL1=YL+1.2*H*SIN(ANG1)
  84.     CALL TEXT('S',H,ANGLE,XL1,YL1,TXT,0,' ',1,'F')
  85.     GOTO 10
  86.     ENDIF
  87.     CALL TEXT('S',H,ANGLE,XL1,YL1,TXT,0,'0',1,'F')
  88.   10    IF(NOC.EQ.'C'.AND.FOL.NE.'     ') GOTO 30
  89.     IF(SCH.EQ.0..AND.XCH.EQ.0.) GOTO 40
  90.     XL1=XL+(ZL1+0.2*H)*COS(ANG1)-0.8*H*SIN(ANG1)
  91.     YL1=YL+(ZL1+0.2*H)*SIN(ANG1)+0.8*H*COS(ANG1)
  92.     IF(SCH.EQ.0)THEN
  93.     CALL TEXT('S',H1,ANGLE,XL1,YL1,0.,0,' 0',2,'A')
  94.     ELSEIF(SCH.GT.0.0)THEN
  95.     CALL TEXT('S',H1,ANGLE,XL1,YL1,0.,0,'+',1,'A')
  96.     ELSEIF(SCH.LT.0.0)THEN
  97.     CALL TEXT('S',H1,ANGLE,XL1,YL1,0.0,0,'-',1,'A')
  98.     SCH=ABS(SCH)
  99.     ENDIF
  100.     XL1=XL1+0.6*H*COS(ANG1)
  101.     YL1=YL1+0.6*H*SIN(ANG1)
  102.     CALL TEXT('S',H1,ANGLE,XL1,YL1,SCH,0,'0',1,'F')
  103.     XL1=XL+(ZL1+0.2*H)*COS(ANG1)
  104.     YL1=YL+(ZL1+0.2*H)*SIN(ANG1)
  105.     IF(XCH.EQ.0)THEN
  106.     CALL TEXT('S',H1,ANGLE,XL1,YL1,0.,0,' 0',2,'A')
  107.     ELSEIF(XCH.GT.0.0)THEN
  108.     CALL TEXT('S',H1,ANGLE,XL1,YL1,0.0,0,'+',1,'A')
  109.     ELSEIF(XCH.LT.0.0)THEN
  110.     CALL TEXT('S',H1,ANGLE,XL1,YL1,0.0,0,'-',1,'A')
  111.     XCH=ABS(XCH)
  112.     ENDIF
  113.     XL1=XL1+0.6*H*COS(ANG1)
  114.     YL1=YL1+0.6*H*SIN(ANG1)
  115.     CALL TEXT('S',H1,ANGLE,XL1,YL1,XCH,0,'0',1,'F')
  116.     GOTO 40
  117.   30    IF(FOL.NE.'     ')THEN
  118.         XL1=XL+(ZL1+0.25*H)*COS(ANG1)
  119.     YL1=YL+(ZL1+0.25*H)*SIN(ANG1)
  120.     CALL TEXT('S',H,ANGLE,XL1,YL1,0.,0,FOL,4,'A')
  121.     ENDIF
  122.   40    RETURN
  123.     END
  124.  
  125.     SUBROUTINE BGD(X,Y,OUTR,ZO,DGCH,PRE,OH,Y0,ID,IL,IR,XB,YB,ANG,
  126.      #    ZF,GCH)
  127.     DIMENSION X(50),Y(50),OUTR(30,13),ZO(30)
  128.     CHARACTER*1 DL,OH,ZF
  129.     CHARACTER*2 OUTA(30)
  130.     CHARACTER*4 GCH(13,56)
  131.     CHARACTER*5 DGCH
  132.     CHARACTER*3 TQGD(2,13),PRE,GD,GDL,GDR
  133.     DATA TQGD/'GD9','GF9','GD9','GF9','GD9','GF9',
  134.      #    'GD8','GF8','GD8','GF8','GD7','GF7','GD7',
  135.      #    'GF7','GD6','GF6','GD6','GF6','GD5','GF5',
  136.      #    'GD5','GF5','GD4','GF4','GD4','GF4'/
  137.     CALL GDDJ(GCH,DGCH,N)
  138.     IF(N.EQ.0)GOTO 10
  139.     IF(PRE.EQ.'%%C')THEN
  140.     IF(OUTR(ID,3).GE.10)THEN
  141.     XB=(ZO(ID+1)+ZO(ID))/2
  142.     YB=Y0+(OUTR(ID,1)+OUTR(ID,2))/4
  143.     ZF='Z'
  144.     IF(OH.EQ.'H')ZF='F'
  145.     ELSE
  146.     XB=X(3)+5*ABS(X(1)-X(3))/(X(1)-X(3))
  147.     YB=AMAX1(Y(1),Y(2))
  148.     ZF='Z'
  149.     IF(OH.EQ.'H')ZF='F'
  150.     ENDIF
  151.     ELSEIF(PRE.EQ.'SHL')THEN
  152.     IF((ABS(OUTR(IL-1,2)-OUTR(IL,1)).GE.40).AND.IL.NE.1)THEN
  153.     XBL=ZO(IL)
  154.     YBL=Y0+OUTR(IL,1)/2-10
  155.     ELSE
  156.     XBL=ZO(IL)
  157.     YBL=Y(3)-5
  158.     IF(OH.EQ.'H')YBL=Y(3)+5
  159.     ENDIF
  160.     IF(IL.EQ.1)THEN
  161.     ZFL='Z'
  162.     ELSEIF(OUTR(IL,1).GT.OUTR(IL-1,2))THEN
  163.     ZFL='Z'
  164.     IF(OH.EQ.'H')ZFL='F'
  165.     ELSE
  166.     ZFL='F'
  167.     IF(OH.EQ.'H')ZFL='Z'
  168.     ENDIF
  169.     IF((ABS(OUTR(IR,2)-OUTR(IR+1,1)).GE.40).AND.IR.NE.IO)THEN
  170.     XBR=ZO(IR+1)
  171.     YBR=Y0+OUTR(IR,2)/2-20
  172.     ELSE
  173.     XBR=ZO(IR+1)
  174.     YBR=Y(3)+5
  175.     IF(OH.EQ.'H')YBR=Y(3)-5
  176.     ENDIF
  177.     IF(IR.EQ.IO)THEN
  178.     ZFR='F'
  179.     ELSEIF(OUTR(IR,2).GT.OUTR(IR+1,1))THEN
  180.     ZFR='F'
  181.     IF(OH.EQ.'H')ZFR='Z'
  182.     ELSE
  183.     ZFR='Z'
  184.     IF(OH.EQ.'H')ZFR='F'
  185.     ENDIF
  186.     ENDIF
  187.     IF(ZF.EQ.'Z')THEN
  188.     GD=TQGD(1,N)
  189.     ELSEIF(ZF.EQ.'F')THEN
  190.     GD=TQGD(2,N)
  191.     ENDIF
  192.     IF(ZFL.EQ.'Z')THEN
  193.     GDL=TQGD(1,N)
  194.     ELSEIF(ZFL.EQ.'F')THEN
  195.     GDL=TQGD(2,N)
  196.     ENDIF
  197.     IF(ZFR.EQ.'Z')THEN
  198.     GDR=TQGD(1,N)
  199.     ELSEIF(ZFR.EQ.'F')THEN
  200.     GDR=TQGD(2,N)
  201.     ENDIF
  202.     IF(PRE.EQ.'%%C')THEN
  203.     CALL INSERT(GD,XB,YB,5.,5.,0.)
  204.     ELSEIF(PRE.EQ.'SHL')THEN
  205.     CALL INSERT(GDL,XBL,YBL,5.,5.,90.)
  206.     CALL INSERT(GDR,XBR,YBR,5.,5.,-90.)
  207.     ELSEIF(PRE.EQ.'DEF')THEN
  208.     CALL INSERT(GD,XB,YB,5.,5.,ANG)
  209.     ENDIF
  210.   10    RETURN
  211.     END
  212.  
  213.     SUBROUTINE GDDJ(GCH,DGCH,N)
  214.     CHARACTER*4 GCH(13,56)
  215.     CHARACTER*5 DGCH
  216.     N=0
  217.         DO 20 I=1,13
  218.     DO 20 J=1,56
  219.     IF(GCH(I,J).EQ.DGCH)THEN
  220.     N=I
  221.     RETURN
  222.     ENDIF
  223.   20    CONTINUE
  224.     RETURN
  225.     END
  226.  
  227.     SUBROUTINE DIMP(ANG,X,Y,DG,D,L)
  228.     DIMENSION X(50),Y(50)
  229.     CHARACTER*5 DG
  230.     CHARACTER*25 FORM
  231.     COMMON SCL
  232.     IF(D/SCL.LE.50)THEN
  233.     IF(ANG.EQ.90.)THEN
  234.     CALL LINE(X(3),Y(1),X(3),Y(2))
  235.     ELSEIF(ANG.EQ.0.)THEN
  236.     CALL LINE(X(1),Y(3),X(2),Y(3))
  237.     ENDIF
  238.     ENDIF
  239.     WRITE(1,'(A)')'DIM'
  240.     WRITE(1,'(A)')'ROTATED'
  241.     WRITE(1,'(E12.7)')ANG
  242.     WRITE(1,'(E12.7,A1,E12.7)')X(1),',',Y(1)
  243.     WRITE(1,'(E12.7,A1,E12.7)')X(2),',',Y(2)
  244.     WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)
  245.     IF(L.EQ.1)THEN
  246.     WRITE(1,'(A2,2A1)')'G ',DG,'"'
  247.     ELSEIF(L.EQ.2)THEN
  248.     WRITE(1,'(A2,A2,A1)')'G ',DG,'"'
  249.     ELSEIF(L.EQ.3)THEN
  250.     WRITE(1,'(A2,A3,A1)')'G ',DG,'"'
  251.     ELSEIF(L.EQ.4)THEN
  252.     WRITE(1,'(A2,A4,A1)')'G ',DG,'"'
  253.     ELSEIF(L.EQ.5)THEN
  254.     WRITE(1,'(A2,A5,A1)')'G ',DG,'"'
  255.     ENDIF
  256.     WRITE(1,'(A)')'EXIT'
  257.     RETURN
  258.     END
  259.     
  260.     SUBROUTINE BZDD(OUTY,ZZ,IOH,GCH,LOH,ROH,LR,Y0,OH,XL0,XR0,CONS,K,
  261.      #    I0)
  262.     DIMENSION OUTY(30,13),ZZ(30),CONS(100,2),X(50),Y(50),X1(50),
  263.      #    Y1(50)
  264.     CHARACTER*1 OH,LR
  265.     CHARACTER*5 GCH(30),LOH(30),ROH(30)
  266.     COMMON SCL
  267.     IF(LOH(I0).NE.'/'.OR.ROH(I0).NE.'/')THEN
  268.     X(1)=ZZ(I0)
  269.     X(2)=X(1)
  270.     Y(1)=Y0-OUTY(I0,1)/2
  271.     Y(2)=Y0+OUTY(I0,1)/2
  272.     X1(1)=ZZ(I0+1)
  273.     X1(2)=X1(1)
  274.     Y1(1)=Y0-OUTY(I0,2)/2
  275.     Y1(2)=Y0+OUTY(I0,2)/2
  276.     Y(3)=(Y(1)+Y(2))/2
  277.     Y1(3)=(Y1(1)+Y1(2))/2
  278.     IF(LOH(I0).EQ.ROH(I0))THEN
  279.     IF(OUTY(I0,1).LT.OUTY(I0,2))THEN
  280.       IF(OUTY(I0,13)*SCL.EQ.2.0)GOTO66
  281.     IF(LOH(I0).EQ.'LO')THEN
  282.     XL0=XL0-12
  283.     X(3)=XL0
  284.     LOH(I0)='/'
  285.     ELSEIF(LOH(I0).EQ.'RO')THEN
  286.     XR0=XR0+12
  287.     X(3)=XR0
  288.     LOH(I0)='/'
  289.     ENDIF
  290.     CALL DIMGCH(X,Y,4.,OUTY(I0,1)*SCL,0.,0.,90.,'%%C','     ')
  291. 66      IF(OUTY(I0,13)*SCL.EQ.1.0)GOTO77
  292.     IF(ROH(I0).EQ.'LO')THEN
  293.     XL0=XL0-12
  294.     X1(3)=XL0
  295.     ROH(I0)='/'
  296.     ELSEIF(ROH(I0).EQ.'RO')THEN
  297.     XR0=XR0+12
  298.     X1(3)=XR0
  299.     ROH(I0)='/'
  300.     ENDIF
  301.     CALL DIMGCH(X1,Y1,4.,OUTY(I0,2)*SCL,0.,0.,90.,'%%C','     ')
  302.     ELSEIF(OUTY(I0,1).GT.OUTY(I0,2))THEN
  303.       IF(OUTY(I0,13)*SCL.EQ.2.0)GOTO88
  304.     IF(ROH(I0).EQ.'LO')THEN
  305.     XL0=XL0-12
  306.     X1(3)=XL0
  307.     ROH(I0)='/'
  308.     ELSEIF(ROH(I0).EQ.'RO')THEN
  309.     XR0=XR0+12
  310.     X1(3)=XR0
  311.     ROH(I0)='/'
  312.     ENDIF
  313.     CALL DIMGCH(X1,Y1,4.,OUTY(I0,2)*SCL,0.,0.,90.,'%%C','     ')
  314. 88      IF(OUTY(I0,13)*SCL.EQ.1.0)GOTO77
  315.     IF(LOH(I0).EQ.'LO')THEN
  316.     XL0=XL0-12
  317.     X(3)=XL0
  318.     LOH(I0)='/'
  319.     ELSEIF(LOH(I0).EQ.'RO')THEN
  320.     XR0=XR0+12
  321.     X(3)=XR0
  322.     LOH(I0)='/'
  323.     ENDIF
  324.     CALL DIMGCH(X,Y,4.,OUTY(I0,1)*SCL,0.,0.,90.,'%%C','     ')
  325. 77    ENDIF
  326.     ELSE
  327.       IF(OUTY(I0,13)*SCL.EQ.1.0.AND.OUTY(I0,1).GT.OUTY(I0,2))GOTO11
  328.       IF(OUTY(I0,13)*SCL.EQ.2.0.AND.OUTY(I0,1).LT.OUTY(I0,2))GOTO11
  329.     IF(LOH(I0).EQ.'LO')THEN
  330.     XL0=XL0-12
  331.     X(3)=XL0
  332.     LOH(I0)='/'
  333.     CALL DIMGCH(X,Y,4.,OUTY(I0,1)*SCL,0.,0.,90.,'%%C','     ')
  334.     ENDIF
  335. 11    IF(OUTY(I0,13)*SCL.EQ.2.0.AND.OUTY(I0,1).GT.OUTY(I0,2))GOTO22
  336.       IF(OUTY(I0,13)*SCL.EQ.1.0.AND.OUTY(I0,1).LT.OUTY(I0,2))GOTO22
  337.     IF(ROH(I0).EQ.'RO')THEN
  338.     XR0=XR0+12
  339.     X1(3)=XR0
  340.     ROH(I0)='/'
  341.     CALL DIMGCH(X1,Y1,4.,OUTY(I0,2)*SCL,0.,0.,90.,'%%C','     ')
  342.     ENDIF
  343. 22    ENDIF
  344. C    CALL BZD(OUTY,ZZ,IOH,GCH,Y0,OH,CONS,K,I0)
  345.     ENDIF
  346.     RETURN
  347.     END
  348.  
  349.     SUBROUTINE BZD(OUTY,ZZ,IOH,GCH,Y0,OH,CONS,K,I0)
  350.     DIMENSION OUTY(30,13),ZZ(30),CONS(100,2)
  351.     CHARACTER*1 OH
  352.     CHARACTER*5 GCH(30)
  353.     XC=(ZZ(I0)+ZZ(I0+1))/2
  354.       IF(GCH(I0).EQ.'    ')GOTO222
  355.     IF(OH.EQ.'O')THEN
  356.     YG=Y0+AMAX1(OUTY(I0,1),OUTY(I0,2))/2+8
  357.     YM=Y0+(OUTY(I0,1)+OUTY(I0,2))/4
  358.     ELSEIF(OH.EQ.'H')THEN
  359.     YG=Y0-AMIN1(OUTY(I0,1),OUTY(I0,2))/2+4
  360.     YM=Y0-(OUTY(I0,1)+OUTY(I0,2))/4
  361.     ENDIF
  362.     IF(GCH(I0).EQ.' 0  '.OR.GCH(I0).EQ.' 1  '.OR.GCH(I0).EQ.
  363.      #    ' 2  '.OR.GCH(I0).EQ.' 3  '.OR.GCH(I0).EQ.' 4  '.OR.GCH(I0)
  364.      #    .EQ.' 5  '.OR.GCH(I0).EQ.' 6  ')THEN
  365.     XF=XC-13
  366.     XE=XC+13
  367.     CALL INSERT('MOS',XF+2,YG+1,4.,4.,0.)
  368.     CALL TEXT('R',4.,0.,XF+16,YG+1.0,0.,0,GCH(I0),4,'A')
  369.     ELSE
  370.     XF=XC-8
  371.     XE=XC+8
  372.     CALL TEXT('R',4.,0.,XC,YG+1,0.,0,GCH(I0),4,'A')
  373.       ENDIF
  374.      CALL SCON(CONS,K,XF,XE)
  375.       IF(GCH(I0).NE.'     ')THEN
  376.         YG=YG+1.5
  377.         IF(OUTY(I0,1).LT.OUTY(I0,2))THEN
  378.     CALL LINE(XF,YG,XF,YG+4.0)
  379.     CALL LINE(XF,YG+4.0,XF-10.0,YG+2.0)
  380.     CALL LINE(XF-10,YG+2.0,XF,YG)
  381.         ELSE
  382.     CALL LINE(XF,YG+2.0,XF-10.0,YG+4.0)
  383.     CALL LINE(XF-10.0,YG+4.0,XF-10.0,YG)
  384.     CALL LINE(XF-10,YG,XF,YG+2.0)
  385.         ENDIF
  386.     CALL LINE(XE-4,YG-1.5,XF-10.0,YG-1.5)
  387.     CALL LINE(XF-10.0,YG-1.5,XC,YM)
  388.     ENDIF
  389.  222  RETURN
  390.     END
  391.  
  392.     SUBROUTINE DIMS(ANG,X,Y,H,D,S,PRE,FOL)
  393.     DIMENSION X(50),Y(50)
  394.     CHARACTER*2 PRE
  395.     CHARACTER*5 FOL
  396.     CHARACTER*25 FORM
  397.     COMMON SCL
  398.     WRITE(1,'(A)')'DIM'
  399.     WRITE(1,'(A)')'ROTATED'
  400.     WRITE(1,'(E12.7)')ANG
  401.     WRITE(1,'(E12.7,A1,E12.7)')X(1),',',Y(1)
  402.     WRITE(1,'(E12.7,A1,E12.7)')X(2),',',Y(2)
  403.     WRITE(1,'(E12.7,A1,E12.7)')X(3),',',Y(3)
  404.     WRITE(1,'(X)')
  405.     WRITE(1,'(A)')'EXIT'
  406.     ND1=0
  407.     IF(D.LT.10.)THEN
  408.     IF(FLOAT(INT(D+0.01)).EQ.D)THEN
  409.     ND1=1
  410.     ELSEIF(FLOAT(INT(D*10+0.01)).EQ.D*10.)THEN
  411.     ND1=2
  412.     ENDIF
  413.     ENDIF
  414.     ND=200
  415.     IF(D.GE.10.AND.D.LT.100)ND=200
  416.     IF(D.GE.100.AND.D.LT.1000)ND=300
  417.     IF(D.GE.1000.AND.D.LT.10000)ND=400
  418.     IF(S.LT.10)THEN
  419.     IF(FLOAT(INT(S+0.01)).EQ.S)THEN
  420.     NS=10
  421.     ELSEIF(FLOAT(INT(S*10+0.01)).EQ.S*10)THEN
  422.     NS=11
  423.     ELSEIF(FLOAT(INT(S*100+0.01)).EQ.S*100)THEN
  424.     NS=12
  425.     ENDIF
  426.     ELSEIF(S.GE.10.AND.S.LT.100)THEN
  427.     IF(FLOAT(INT(S+0.01)).EQ.S)THEN
  428.     NS=20
  429.     ELSEIF(FLOAT(INT(S*10+0.01)).EQ.S*10)THEN
  430.     NS=21
  431.     ELSEIF(FLOAT(INT(S*100+0.01)).EQ.S*100)THEN
  432.     NS=22
  433.     ENDIF
  434.     ENDIF
  435.     NF=ND+NS
  436.      IF(NF.EQ.210)THEN
  437.     ZL=11*H
  438.     ELSEIF(NF.EQ.211)THEN
  439.     ZL=13*H
  440.          ELSEIF(NF.EQ.212)THEN
  441.     ZL=14*H
  442.          ELSEIF(NF.EQ.220)THEN
  443.     ZL=12*H
  444.          ELSEIF(NF.EQ.221)THEN
  445.     ZL=14*H
  446.          ELSEIF(NF.EQ.222)THEN
  447.     ZL=15*H
  448.          ELSEIF(NF.EQ.310)THEN
  449.     ZL=12*H
  450.          ELSEIF(NF.EQ.311)THEN
  451.     ZL=14*H
  452.          ELSEIF(NF.EQ.312)THEN
  453.     ZL=15*H
  454.          ELSEIF(NF.EQ.320)THEN
  455.     ZL=13*H
  456.          ELSEIF(NF.EQ.321)THEN
  457.     ZL=15*H
  458.          ELSEIF(NF.EQ.322)THEN
  459.     ZL=16*H
  460.     ENDIF
  461.     IF(ND1.EQ.1)ZL=ZL-H
  462.     IF(ND1.EQ.2)ZL=ZL+H
  463.     ID=INT(D)
  464.     IS=INT(S)
  465.     IF(FOL.EQ.'     ')THEN
  466.     ZL=ZL-6*H
  467.     ENDIF
  468.     IF((D/SCL-ZL).GE.12)THEN
  469.     XL=X(3)-0.5*H
  470.     YL=(Y(1)+Y(2))/2-ZL/2
  471.     ELSE
  472.     CALL LINE(X(3),Y(1),X(3),Y(2))
  473.     IF(Y(1).LT.Y(2))THEN
  474.     YL=Y(2)+9
  475.     ELSE
  476.     YL=Y(2)-9-ZL
  477.     ENDIF
  478.     XL=X(3)+H/2
  479.     ENDIF
  480.     CALL TEXT('S',H,90.0,XL,YL,0.0,0,PRE,1,'A')
  481.     YL=YL+1.2*H
  482.     IF(ND1.EQ.0)THEN
  483.     CALL TEXT('S',H,90.,XL,YL,0.,ID,'0',1,'I')
  484.     YL=YL+ND*H/100
  485.     ELSEIF(ND1.EQ.1)THEN
  486.     CALL TEXT('S',H,90.,XL,YL,0.,ID,'0',1,'I')
  487.     YL=YL+H
  488.     ELSEIF(ND1.EQ.2)THEN
  489.     CALL TEXT('S',H,90.,XL,YL,D,0,'0',1,'F')
  490.     YL=YL+2.5*H
  491.     ENDIF
  492.     CALL TEXT('S',H,90.,XL,YL,0.,0,'X',1,'A')
  493.     YL=YL+H
  494.     IF(NS.EQ.10.OR.NS.EQ.20)THEN
  495.     CALL TEXT('S',H,90.,XL,YL,0.,IS,'0',1,'I')
  496.     YL=YL+NS*H/10
  497.     ELSE
  498.     CALL TEXT('S',H,90.,XL,YL,S,0,'0',1,'F')
  499.     YL=YL+H*(INT(NS/10)+NS-INT(NS/10)*10+1)
  500.     ENDIF
  501.     IF(FOL.NE.'     ')THEN
  502.     CALL TEXT('S',H,90.,XL,YL,0.,0,'-',1,'A')
  503.     CALL TEXT('S',H,90.,XL,YL+H,0.,0,FOL,5,'A')
  504.     ENDIF
  505.     RETURN
  506.     END
  507.     
  508.     SUBROUTINE DECIM(W,ND,NS)
  509.     AW=W
  510.     IF(AW.LT.0.)AW=-AW
  511.     IF(AW.LT.10)ND=10
  512.     IF(AW.GE.10.AND.AW.LT.100)ND=20
  513.     IF(AW.GE.100.AND.AW.LT.1000)ND=30
  514.     IF(AW.GE.1000.AND.AW.LT.10000)ND=40
  515.     AX0=FLOAT(INT(AW+0.00001))
  516.     IF(AW.LT.1)AX0=0
  517.     AX1=FLOAT(INT(AW*10.+0.0001))/10.
  518.     AX2=FLOAT(INT(AW*100.+0.001))/100.
  519.     IF(AW.EQ.AX0)THEN
  520.     NS=0
  521.     GOTO 10
  522.     ENDIF
  523.     IF(AW.EQ.AX1)THEN
  524.     NS=1
  525.     GOTO 10
  526.     ENDIF
  527.     IF(AW.EQ.AX2)THEN
  528.     NS=2
  529.     GOTO 10
  530.     ENDIF
  531.     NS=3
  532.   10    RETURN
  533.     END
  534.  
  535.     SUBROUTINE BYK(XC,YC,Y0,R1,R2,CL,KN,KS,ANK,DMAX,TH,ITY,KTG,K)
  536.     CHARACTER*2 TH
  537.     CHARACTER*5 KTG
  538.     IF((K.EQ.1.AND.ANK.EQ.0.).OR.(K.EQ.2.AND.ANK.NE.0.))THEN
  539.     AT=8.
  540.     ELSE
  541.     AT=24.
  542.     ENDIF
  543.     X3=XC+0.707*R1/2
  544.     Y3=YC-0.707*R1/2
  545.     X4=XC-0.707*R1/2
  546.     Y4=YC+0.707*R1/2
  547.     X2=X3+2.8
  548.     Y2=Y3-2.8
  549.     X1=X2+2.8
  550.     Y1=Y2-2.8
  551.     X5=X4-2.8
  552.     Y5=Y4+2.8
  553.     Y6=Y0+DMAX/2+AT
  554.       IF(KS.EQ.1.AND.ANK.EQ.180.)THEN
  555.       Y6=Y0-DMAX/2-AT
  556.       ENDIF
  557.     X6=XC-Y6+YC
  558.     IF(KN.EQ.1.AND.KTG.EQ.'  ')THEN
  559.     LLX=25
  560.     ELSE
  561.     LLX=35
  562.     ENDIF
  563.     IF((K.EQ.1.AND.ANK.EQ.0.).OR.K.EQ.2.OR.(KS.EQ.1.AND.
  564.      # ANK.EQ.180.))THEN
  565.     X7=X6-LLX
  566.     XF=X7
  567.     ELSE
  568.     X7=X6+LLX
  569.     XF=X6
  570.     ENDIF
  571.     Y7=Y6
  572.     WRITE(1,'(A)')'PLINE'
  573.     WRITE(1,'(E12.7,A1,E12.7)')X1,',',Y1
  574.     WRITE(1,'(A)')'W'
  575.     WRITE(1,'(F2.1)').0
  576.     WRITE(1,'(F2.1)').0
  577.     WRITE(1,'(E12.7,A1,E12.7)')X2,',',Y2
  578.     WRITE(1,'(A)')'W'
  579.     WRITE(1,'(F3.1)')1.4
  580.     WRITE(1,'(F2.1)').0
  581.     WRITE(1,'(E12.7,A1,E12.7)')X3,',',Y3
  582.     WRITE(1,'(E12.7,A1,E12.7)')X4,',',Y4
  583.     WRITE(1,'(A)')'W'
  584.     WRITE(1,'(F2.1)').0
  585.     WRITE(1,'(F3.1)')1.4
  586.     WRITE(1,'(E12.7,A1,E12.7)')X5,',',Y5
  587.     WRITE(1,'(A)')'W'
  588.     WRITE(1,'(F2.1)').0
  589.     WRITE(1,'(F2.1)').0
  590.     WRITE(1,'(E12.7,A1,E12.7)')X6,',',Y6
  591.     WRITE(1,'(E12.7,A1,E12.7,X)')X7,',',Y7
  592.     IF(KN.EQ.2.AND.KTG.EQ.' ')THEN
  593.     XL=XF+11
  594.     ELSE
  595.     XL=XF+5
  596.     ENDIF
  597.     YL=Y6+0.8
  598.     IF(KS.GT.1)THEN
  599.     CALL TEXT('S',4.,0.,XL,YL,0.0,KS,'0',1,'I')
  600.     IF(KS.GT.10)THEN
  601.       XL=XL+6.5
  602.       ELSE
  603.       XL=XL+4.
  604.       ENDIF
  605.     CALL TEXT('S',4.,0.,XL,YL,0.0,0,'-',1,'A')
  606.     ENDIF
  607.     XL=XL+4.
  608.     IF(TH.EQ.'DK'.OR.TH.EQ.'LK')THEN
  609.     CALL TEXT('S',4.,0.,XL,YL,0.0,0,'M',1,'A')
  610.     ELSE
  611.     CALL TEXT('S',4.,0.,XL,YL,0.0,0,'%%C',3,'A')
  612.     ENDIF
  613.     XL=XL+4.
  614.     CALL TEXT('S',4.,0.,XL,YL,R1,0,'0',1,'F')
  615.     IF(KTG.NE.'     '.AND.TH.NE.'GK')THEN
  616.     IF(R1.LT.10)THEN
  617.     XL=XL+4
  618.     ELSE
  619.     XL=XL+8
  620.     ENDIF
  621.     CALL TEXT('S',4.,0.,XL,YL,0.0,0,'-',1,'A')
  622.     CALL TEXT('S',4.,0.,XL+4,YL,0.0,0,KTG,4,'A')
  623.     ENDIF
  624.     IF(TH.EQ.'ZK')THEN
  625.     IF(R1.LT.10.)THEN
  626.     XL=XL+4
  627.     ELSE
  628.     XL=XL+8
  629.     ENDIF
  630.     CALL SHAPE('ZXAUK',0.3,0.,XL,YL)
  631.     ENDIF
  632.     IF(KN.EQ.2)THEN
  633.     XL1=XF+5
  634.     YL1=Y6-4.8
  635.     CALL INSERT('CGK',XL1,YL1,4.8,4.8,0.)
  636.     XL1=XL1+8.
  637.     CALL TEXT('S',4.,0.,XL1,YL1,0.0,0,'%%C',3,'A')
  638.     XL1=XL1+4.
  639.     CALL TEXT('S',4.,0.,XL1,YL1,R2,0,'0',1,'F')
  640.     IF(R2.LT.10)THEN
  641.     XL1=XL1+4.
  642.     ELSE
  643.     XL1=XL1+8
  644.     ENDIF
  645.     IF(ITY.EQ.2)THEN
  646.     CALL INSERT('XGZ',XL1,YL1,3.4,4.3,0.)
  647.     XL1=XL1+4.
  648.     CALL TEXT('S',4.,0.,XL1,YL1,CL,0,'0',1,'F')
  649.     ELSE
  650.     CALL TEXT('S',4.,0.,XL1,YL1,0.0,0,'X',1,'A')
  651.     XL1=XL1+4
  652.     CALL TEXT('S',4.,0.,XL1,YL1,0.0,0,'90',2,'A')
  653.     XL1=XL1+8
  654.     CALL TEXT('S',4.,0.,XL1,YL1,0.0,0,'%%D',3,'A')
  655.     ENDIF
  656.     ENDIF
  657.     IF(KN.NE.2.AND.TH.NE.'LK'.AND.TH.NE.'XK')THEN
  658.     IF(KTG.NE.'    ')THEN
  659.     XL1=XF+15
  660.     ELSE
  661.     XL1=XF+8
  662.     ENDIF
  663.     YL1=Y6-4.8
  664.     CALL INSERT('XGZ',XL1,YL1,3.4,4.3,0.)
  665.     XL1=XL1+4.
  666.     CALL TEXT('S',4.,0.,XL1,YL1,CL,0,'0',1,'F')
  667.     ENDIF
  668.     RETURN
  669.     END
  670.  
  671.     SUBROUTINE ARC(XA,YA,XC,YC,ALF)
  672.     WRITE(1,'(A)')'ARC'
  673.     WRITE(1,'(E12.7,A1,E12.7)')XA,',',YA
  674.     WRITE(1,'(A)')'C'
  675.     WRITE(1,'(E12.7,A1,E12.7)')XC,',',YC
  676.     WRITE(1,'(A)')'A'
  677.     WRITE(1,'(E12.7)')ALF
  678.     RETURN
  679.     END
  680.  
  681.     SUBROUTINE SHAPE(NAME,H,ANG,X,Y)
  682.     CHARACTER*5 NAME
  683.     WRITE(1,'(A)')'LOAD'
  684.     WRITE(1,'(A)')'JCSHZ'
  685.     WRITE(1,'(A)')'SHAPE'
  686.     WRITE(1,'(A)')NAME
  687.     WRITE(1,'(E12.7,A1,E12.7)')X,',',Y
  688.     WRITE(1,'(E12.7)')H
  689.     WRITE(1,'(E12.7)')ANG
  690.     RETURN
  691.     END
  692.  
  693.         SUBROUTINE PLINE(XF,YF,XM,YM)
  694.         A=0.0
  695.         B=1.2
  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)')A
  700.         WRITE(1,'(E12.7)')B
  701.         WRITE(1,'(E12.7,A1,E12.7,X)')XM,',',YM
  702.         RETURN
  703.         END
  704.