home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 13.ddi / PO4.FOR < prev    next >
Encoding:
Text File  |  1987-07-15  |  7.7 KB  |  354 lines
  1.       SUBROUTINE TRNS(V,T)
  2.       DIMENSION T(3)
  3.       KK=LENSTR(T,V)
  4.       RETURN
  5.       END
  6.       SUBROUTINE ANSTRY(NCHAR,XNADE)
  7.       DIMENSION XNADE(1)
  8.       CALL ANMODE
  9.       IX=NCHAR/4
  10.       IF(IX.LT.1)GO TO 10
  11.       IF(IX*4.EQ.NCHAR)GO TO 30
  12.       IX=IX+1
  13.       GO TO 30
  14. 10    IX=1
  15. 30    IXB=IX*4
  16.       CALL ANSTR3(NCHAR,XNADE,IX,IXB)
  17.       RETURN
  18.       END
  19.       SUBROUTINE ANSTR3(NCHAR,XNADE,IX,IXB)
  20.       COMMON/IGL100/IGLKEY,IBAUD,IDEV,IOPT,PXSIZE,PYSIZE
  21.       DIMENSION XNADE(IX)
  22.       IHOR=PXSIZE
  23.       IVER=PYSIZE
  24.       CALL CSIZE(IHOR,IVER)
  25.       DO 33 I=1,IX
  26.       CALL ANSTR(1,XNADE(I))
  27.       CALL LINREL(0,-IVER,0)
  28.       CALL LINREL(-IHOR,-IVER,0)
  29.       CALL ANMODE
  30. 33    CONTINUE
  31.       RETURN
  32.       END
  33.       SUBROUTINE PLINE1(IX,IY,IPEN,LINTYP)
  34.       COMMON/BEAPOS/IX1,IY1
  35.       IF(IPEN.EQ.1)GO TO 10
  36.       X=FLOAT(IX)*1.4
  37.       IX1=IFIX(X)
  38.       IY1=IY
  39.       RETURN
  40. 10    X=FLOAT(IX)*1.4
  41.       IIX=IFIX(X)
  42.       WRITE(23,11)IX1,IY1,LINTYP,IIX,IY
  43. 11    FORMAT(1X,8H`PLINE (,I4,1H,,I4,1H),I2,1H,,I4,1H,,I4,1H!)
  44.       IX1=IIX
  45.       IY1=IY
  46.       RETURN
  47.       END
  48.       SUBROUTINE LINE2(X,Y,IPEN)
  49.       COMMON/HP21/IHP,PAT,HI21,X21,Y21
  50.       COMMON/CALCOM/ICAL
  51.       COMMON/IGL100/IGLKEY
  52.       IF(ICAL.EQ.1)GO TO 2
  53.       IIX=X
  54.       IIY=Y
  55.       IF(IPEN.EQ.1)CALL MOVEA(X,Y)
  56.       IF(IPEN.EQ.4)CALL DRWREL(IIX,IIY)
  57.       IF(IPEN.EQ.3)CALL MOVREL(IIX,IIY)
  58.       GO TO 10
  59. 2     WRITE(10,21)IPEN,X,Y
  60. 21    FORMAT(I10,2F10.3)
  61. 10    RETURN
  62.       END
  63.       SUBROUTINE PLOTDT(ITYP,IX,IA,NCP)
  64.       COMMON/UNIT/II11,II22
  65.       DIMENSION IIX(60),IX(8),KOD(20),IA(20),KEX(80)
  66.       IF(ITYP.EQ.0)WRITE(19)ITYP
  67.       IF(ITYP.EQ.0)RETURN
  68.       IX1=-IX(1)
  69.       GO TO (10,20,30,50,60,80,90,100,110,120,400,400,400,90,400,400
  70.      1,90,600),ITYP
  71.       GO TO 500
  72. 10    NCP=2
  73.       WRITE(19)NCP
  74.       WRITE(19)IX1,IX(2)
  75.       GO TO 520
  76. 20    GO TO 10
  77. 30    NCP=5
  78.       IF(IX(4).EQ.0)GO TO 40
  79.       WRITE(19)NCP
  80.       WRITE(19)IX1,IX(2),IX(3),IX(4),IX(1)
  81.       GO TO 520
  82. 40    NCP=4
  83.       WRITE(19)NCP
  84.       WRITE(19)IX1,IX(2),IX(3),IX(1)
  85.       GO TO 520
  86. 50    GO TO 30
  87. 60    IF(IX(7).EQ.0) GO TO 70
  88.       NCP=16
  89.       WRITE(19)NCP
  90.       IX2=-IX(2)
  91.       IX3=-IX(3)
  92.       IX4=-IX(4)
  93.       WRITE(19)IX1,IX(2),IX(3),IX(4),IX(1),IX(5),IX(6),IX(7),
  94.      1IX(8),IX(5),IX4,IX(8),IX3,IX(7),IX2,IX(6)
  95.       GO TO 520
  96. 70    NCP=12
  97.       WRITE(19)NCP
  98.       IX2=-IX(2)
  99.       IX3=-IX(3)
  100.       IX4=-IX(4)
  101.       WRITE(19)IX1,IX(2),IX(3),IX(1),IX(4),IX(5),IX(6),IX(4),
  102.      1IX2,IX(5),IX3,IX(6)
  103.       GO TO 520
  104. 80    GO TO 30
  105. 90    MHIM=0
  106.       WRITE(19)MHIM
  107.       GO TO 520
  108. 100   GO TO 30
  109. 110   NCP=3
  110.       WRITE(19)NCP
  111.       WRITE(19)IX1,IX(2),IX(3)
  112.       GO TO 520
  113. 120   DO 130 I=1,8
  114. 130   KOD(I)=IX(I)
  115.       DO 140 I=9,20
  116. 140   KOD(I)=IA(I)
  117.       KOD1=-KOD(1)
  118.       KOD2=-KOD(2)
  119.       KOD3=-KOD(3)
  120.       KOD4=-KOD(4)
  121.       KOD5=-KOD(5)
  122.       JF=1
  123. 150   IF (KOD(9) .EQ. 0) GO TO 160
  124.       KEX(JF)=KOD1
  125.       JF=JF+1
  126.       KEX(JF)=KOD(9)
  127.       JF=JF+1
  128.       KEX(JF)=KOD(2)
  129.       JF=JF+1
  130.       GO TO 170
  131. 160   KEX(JF)=KOD1
  132.       JF=JF+1
  133.       KEX(JF)=KOD(2)
  134.       JF=JF+1
  135. 170   IF (KOD(10) .EQ. 0) GO TO 180
  136.       KEX(JF)=KOD(10)
  137.       JF=JF+1
  138.       KEX(JF)=KOD(3)
  139.       JF=JF+1
  140.       GO TO 190
  141. 180   KEX(JF)=KOD(3)
  142.       JF=JF+1
  143. 190   IF (KOD(11) .EQ. 0) GO TO 200
  144.       KEX(JF)=KOD(11)
  145.       JF=JF+1
  146.       KEX(JF)=KOD(4)
  147.       JF=JF+1
  148.       GO TO 210
  149. 200   KEX(JF)=KOD(4)
  150.       JF=JF+1
  151. 210   IF (KOD(12) .EQ. 0) GO TO 220
  152.       KEX(JF)=KOD(12)
  153.       JF=JF+1
  154.       KEX(JF)=KOD(1)
  155.       JF=JF+1
  156.       GO TO 230
  157. 220   KEX(JF)=KOD(1)
  158.       JF=JF+1
  159. 230   IF (KOD(13) .EQ. 0) GO TO 240
  160.       KEX(JF)=KOD5
  161.       JF=JF+1
  162.       KEX(JF)=KOD(13)
  163.       JF=JF+1
  164.       KEX(JF)=KOD(6)
  165.       JF=JF+1
  166.       GO TO 250
  167. 240   KEX(JF)=KOD5
  168.       JF=JF+1
  169.       KEX(JF)=KOD(6)
  170.       JF=JF+1
  171. 250   IF (KOD(14) .EQ. 0) GO TO 260
  172.       KEX(JF)=KOD(14)
  173.       JF=JF+1
  174.       KEX(JF)=KOD(7)
  175.       JF=JF+1
  176.       GO TO 270
  177. 260   KEX(JF)=KOD(7)
  178.       JF=JF+1
  179. 270   IF (KOD(15) .EQ. 0) GO TO 280
  180.       KEX(JF)=KOD(15)
  181.       JF=JF+1
  182.       KEX(JF)=KOD(8)
  183.       JF=JF+1
  184.       GO TO 290
  185. 280   KEX(JF)=KOD(8)
  186.       JF=JF+1
  187. 290   IF (KOD(16) .EQ. 0) GO TO 300
  188.       KEX(JF)=KOD(16)
  189.       JF=JF+1
  190.       KEX(JF)=KOD(5)
  191.       JF=JF+1
  192.       GO TO 310
  193. 300   KEX(JF)=KOD(5)
  194.       JF=JF+1
  195. 310   IF (KOD(17) .EQ. 0) GO TO 320
  196.       KEX(JF)=KOD(17)
  197.       JF=JF+1
  198.       KEX(JF)=KOD(1)
  199.       JF=JF+1
  200.       GO TO 330
  201. 320   KEX(JF)=KOD(1)
  202.       JF=JF+1
  203. 330   IF (KOD(18) .EQ. 0) GO TO 340
  204.       KEX(JF)=KOD2
  205.       JF=JF+1
  206.       KEX(JF)=KOD(18)
  207.       JF=JF+1
  208.       KEX(JF)=KOD(6)
  209.       JF=JF+1
  210.       GO TO 350
  211. 340   KEX(JF)=KOD2
  212.       JF=JF+1
  213.       KEX(JF)=KOD(6)
  214.       JF=JF+1
  215. 350   IF (KOD(19) .EQ. 0) GO TO 360
  216.       KEX(JF)=KOD3
  217.       JF=JF+1
  218.       KEX(JF)=KOD(19)
  219.       JF=JF+1
  220.       KEX(JF)=KOD(7)
  221.       JF=JF+1
  222.       GO TO 370
  223. 360   KEX(JF)=KOD3
  224.       JF=JF+1
  225.       KEX(JF)=KOD(7)
  226.       JF=JF+1
  227. 370   IF (KOD(20) .EQ. 0) GO TO 380
  228.       KEX(JF)=KOD4
  229.       JF=JF+1
  230.       KEX(JF)=KOD(20)
  231.       JF=JF+1
  232.       KEX(JF)=KOD(8)
  233.       JF=JF+1
  234.       GO TO 390
  235. 380   KEX(JF)=KOD4
  236.       JF=JF+1
  237.       KEX(JF)=KOD(8)
  238.       JF=JF+1
  239. 390   CONTINUE
  240.       NCP=JF-1
  241.       WRITE(19)NCP
  242.       WRITE(19)(KEX(JJJ),JJJ=1,NCP)
  243.       GO TO 520
  244. 400   NCP=0
  245.       IF(IX(5).EQ.0) GO TO 410
  246.       IIX(1)=IX1
  247.       IIX(2)=IX(5)
  248.       IIX(3)=IX(2)
  249.       NCP=NCP+3
  250.       GO TO 420
  251. 410   IIX(1)=IX1
  252.       IIX(2)=IX(2)
  253.       NCP=NCP+2
  254. 420   IF (IX(6).EQ.0) GO TO 430
  255.       IIX(NCP+1)=IX(6)
  256.       IIX(NCP+2)=IX(3)
  257.       NCP=NCP+2
  258.       GO TO 440
  259. 430   IIX(NCP+1)=IX(3)
  260.       NCP=NCP+1
  261. 440   IF (IX(7).EQ.0) GO TO 450
  262.       IIX(NCP+1)=IX(7)
  263.       IF(IX(4).EQ.0)GO TO 465
  264.       IIX(NCP+2)=IX(4)
  265.       NCP=NCP+2
  266.       GO TO 460
  267. 450   IF(IX(4).EQ.0)GO TO 460
  268.       NCP=NCP+1
  269.       IIX(NCP)=IX(4)
  270. 460   IF (IX(8).EQ.0) GO TO 470
  271. 461   IIX(NCP+1)=IX(8)
  272.       IIX(NCP+2)=IX(1)
  273.       NCP=NCP+2
  274.       GO TO 480
  275. 465   IIX(NCP+2)=IX(1)
  276.       NCP=NCP+2
  277.       GO TO 480
  278. 470   NCP=NCP+1
  279.       IIX(NCP)=IX(1)
  280. 480   IF(ITYP.NE.16)GO TO 481
  281.       IF(IA(9).EQ.0)GO TO 481
  282.       IIX(NCP+1)=-IA(9)
  283.       NCP=NCP+1
  284. 481   WRITE(19) NCP
  285.       WRITE(19) (IIX(I),I=1,NCP)
  286.       GO TO 520
  287. 500   WRITE(*,510)ITYP
  288. 510   FORMAT(' ***** PLOTTER FOR ELEMENT TYPE ',I3,'NOT AVAILABLE')
  289. 520   RETURN
  290. 600   DO 601 I=1,8
  291. 601   KOD(I)=IX(I)
  292.       DO 602 I=9,20
  293. 602   KOD(I)=IA(I)
  294.       NCP=1
  295.       K1K=0
  296.       IIX(1)=IX1
  297.       NCP=NCP+1
  298.       IF(KOD(5).EQ.0)GO TO 610
  299.       IIX(NCP)=KOD(5)
  300.       NCP=NCP+1
  301. 610   IF(KOD(9).EQ.0)GO TO 620
  302.       K1K=0
  303.       DO 621 I=10,16
  304.       IF(KOD(I).NE.0)K1K=1
  305. 621   CONTINUE
  306.       IF(K1K.EQ.1)GO TO 622
  307.       GO TO 620
  308. 622   IIX(NCP)=KOD(9)
  309.       NCP=NCP+1
  310. 620   IIX(NCP)=KOD(2)
  311.       NCP=NCP+1
  312.       IF(KOD(6).EQ.0)GO TO 630
  313.       IIX(NCP)=KOD(6)
  314.       NCP=NCP+1
  315. 630   IF(KOD(10).EQ.0)GO TO 640
  316.       IIX(NCP)=KOD(10)
  317.       NCP=NCP+1
  318. 640   IIX(NCP)=KOD(3)
  319.       NCP=NCP+1
  320.       IF(KOD(7).EQ.0)GO TO 650
  321.       IIX(NCP)=KOD(7)
  322.       NCP=NCP+1
  323. 650   IF(KOD(11).EQ.0)GO TO 660
  324.       IIX(NCP)=KOD(11)
  325.       NCP=NCP+1
  326. 660   IIX(NCP)=KOD(4)
  327.       NCP=NCP+1
  328.       IF(KOD(8).EQ.0)GO TO 670
  329.       IIX(NCP)=KOD(8)
  330.       NCP=NCP+1
  331. 670   IF(KOD(12).EQ.0)GO TO 680
  332.       IIX(NCP)=KOD(12)
  333.       NCP=NCP+1
  334. 680   IIX(NCP)=KOD(1)
  335.       IF(KOD(13).EQ.0)GO TO 690
  336.       NCP=NCP+1
  337.       IIX(NCP)=-KOD(13)
  338. 690   IF(KOD(14).EQ.0)GO TO 691
  339.       NCP=NCP+1
  340.       IIX(NCP)=-KOD(14)
  341. 691   IF(KOD(15).EQ.0)GO TO 692
  342.       NCP=NCP+1
  343.       IIX(NCP)=-KOD(15)
  344. 692   IF(KOD(16).EQ.0)GO TO 693
  345.       NCP=NCP+1
  346.       IIX(NCP)=-KOD(16)
  347. 693   CONTINUE
  348.       IF(K1K.EQ.0)NCP=NCP+1
  349.       IF(K1K.EQ.0)IIX(NCP)=-KOD(9)
  350.       WRITE(19)NCP
  351.       WRITE(19)(IIX(JJJ),JJJ=1,NCP)
  352.       RETURN
  353.       END
  354.