home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 13.ddi / PO3.FOR < prev    next >
Encoding:
Text File  |  1987-10-30  |  15.1 KB  |  601 lines
  1.       SUBROUTINE LABEL (IM)
  2.       INTEGER*4 MODE,MOD22,LOMO
  3.       DIMENSION F2NAME(4),PLNAME(3),SNAP(3),SAP6(3),USER(4),USC(4)
  4.       DIMENSION DAT(7),VD(3),PL(3),CL(3),VDR(3),TIMSS(4),CALIF(4)
  5.       DIMENSION ARROW(3),ONEIN(3),ASQ1(3),TIT(13),LOMO(6),CROT(4)
  6.       DIMENSION X0X(3)
  7.       DIMENSION FREQ(3),MOD22(3)
  8.       DIMENSION MODE(3),FSCAL(4),MOMOX(2)
  9.       COMMON /ANG/H,SX,SY,CX,CY,IDC(3)
  10.       COMMON/ABNAME/XFNAME
  11.       COMMON/RAMTEK/MTEK1
  12.       COMMON/VS11VA/IVS11,IMOVE,NNSTEP
  13.       COMMON/ROTAT/IROT,TETA,DIREC,ANTETA
  14.       COMMON/NSAP6/ISAP6,LOAD6,MODESH,FREQUE
  15.       COMMON/MODEL/MODEL1
  16.       COMMON/TITEL1/DUM(26)
  17.       COMMON/MSTREE/S100,S101,KALOR
  18.       COMMON/ABNAM1/ICH22
  19.       COMMON/HP21/IHP21,PAT21,HI21,X21,Y21
  20.       COMMON/CDC100/IJJJ
  21.       COMMON/STRESS/IFLOK,IST1,SCL1,NSIG,IDIR,SHOST
  22.       COMMON /BX/BM(3),BL(6)
  23.       COMMON /PLT/IPN,IEN,ILN,XB,YB,SC,SCL,SCD,SCFL,SCFD,ISR,INR,LABL
  24.      1,TYPEU,TYPED,WHAT,LNTYPD,LNTYPU,SCALE
  25.       COMMON /PAR/XJOB(2),NOFST,NWFM,NLCT,LCASE
  26.       COMMON/LAB/ILAB
  27.       DIMENSION IDATE0(7),IDATE1(4),ITIME0(4)
  28.       DATA VDR/4HVIEW,4H DIR,2H.:/,DATE00/4HDATE/,TIME00/4HTIME/
  29.       DATA VD,PL/4HVIEW,4HING ,4HDIST,4HPLOT,4H LIM,4HITS:/
  30.       DATA CL/1HX,1HY,1HZ/
  31.       DATA MODE/4HMODE,4H SHA,2HPE/
  32.       DATA FREQ/4HFREQ,4HUENC,1HY/
  33.       DATA SNAP/4HPOST,4H/SAP,4H7   /
  34.       DATA MOD22/4HPOST,4H/MOD,2HEL/
  35.       DATA CROT/4HROTA,4HTION,4H AXE,2HS:/
  36.       DATA SAP6/4HPOST,4H-SAP,4H6/AT /
  37.       DATA USER/4HINST,4HITUT,4HE OF,4H COM/
  38.       DATA USC/4HPUTE,4HR TE,4HC. O,4HF T./
  39.       DATA CALIF/4HU.P ,4HBEIJ,4HING ,2H87/
  40.       DATA LOMO/4HLOAD,4H CAS,4HE , ,4HMODE,4H SHA,2HPE/
  41.       DATA ONEIN/4HONE ,4HINCH,2H :/
  42.       DATA UUU/1HU/
  43.       DATA ARROW/4HARRO,4HW SC,3HALE/
  44.       DATA BLAN/1H /
  45.       DATA PLNAME/4HPLOT,4H NAM,3HE.:/
  46.       DATA FSCAL/4HDEFO,4HRMED,4H SCA,2HLE/
  47.       IJJJ=0
  48.       CALL OFFSET (0)
  49.       IF(ILAB.EQ.0) GOTO 500
  50.       CALL SETPT(1000,800)
  51.       CALL LINA(0,800,1,0)
  52.       CALL LINA(0,0,1,0)
  53.       CALL LINA(1000,0,1,0)
  54.       CALL LINA(1000,800,1,0)
  55.       RETURN
  56. 500   CALL SETPT (800,800)
  57.       CALL LINA (0,800,1,0)
  58.       CALL LINA (0,0,1,0)
  59.       CALL LINA (800,0,1,0)
  60.       JU1=1
  61.       DO 40 M1=1,26,2
  62.       TIT(JU1)=DUM(M1)
  63.       JU1=JU1+1
  64. 40    CONTINUE
  65.       DO 42 M1=1,13
  66.       J1J1=14-M1
  67.       IF(TIT(J1J1).NE.BLAN)GO TO 43
  68. 42    CONTINUE
  69.       GO TO 50
  70. 43    M1=J1J1
  71.       M1=M1*4
  72.       IXPO1=400-M1*7
  73.       IYPO1=770
  74.       CALL SETPT(IXPO1,IYPO1)
  75.       CALL TEXT10(TIT,M1)
  76.       IF(MODESH.EQ.0)GO TO 20
  77.       CALL SETPT(150,21)
  78.       CALL TEXT10(MODE,10)
  79.       CALL ENF1(MODESH,MOMO)
  80.       CALL SETPT(310,21)
  81.       CALL TEXT10(MOMO,4)
  82.       CALL SETPT(420,21)
  83.       CALL TEXT10(FREQ,9)
  84.       CALL ENF(FREQUE,DAT(1))
  85.       CALL SETPT(570,21)
  86.       IJJJ=1
  87.       CALL TEXT10(DAT(1),10)
  88.       IJJJ=0
  89.       GO TO 50
  90. 20    IF(WHAT.EQ.UUU)GO TO 50
  91.       CALL SETPT(200,21)
  92.       CALL TEXT10(LOMO,24)
  93.       CALL ENF1(LOAD6,MOMO)
  94.       CALL SETPT(520,21)
  95.       CALL TEXT10(MOMO,4)
  96. 50    CALL HOME
  97.       CALL OFFSET(1)
  98.       CALL SETPT (0,0)
  99.       CALL LINA (223,0,1,0)
  100.       CALL LINA (223,800,1,0)
  101.       CALL LINA (0,800,1,0)
  102.       CALL LINA (0,0,1,0)
  103.       CALL PLTAXS(1,SC)
  104.       CALL SETPT(0,294)
  105.       CALL LINA (223,294,1,0)
  106.       CALL SETPT(41,272)
  107.       CALL TEXT10       (VDR(1),10)
  108.       DO 81 I=1,3
  109.       LL00=70*I-70
  110.       CALL SETPT (LL00,250)
  111.       CALL CONV (IDC(I),X)
  112. 81    CALL TEXT10       (X,4)
  113.       CALL SETPT (20,245)
  114.       CALL LINA   (203,245,1,3434)
  115.       CALL SETPT(20,218)
  116.       CALL TEXT10       (VD(1),12)
  117.       CALL SETPT(41,196)
  118.       CALL ENF (H,DAT(1))
  119.       IJJJ=1
  120.       CALL TEXT10       (DAT(1),10)
  121.       IJJJ=0
  122.       CALL SETPT (0,190)
  123.       CALL LINA (223,190,1,0)
  124.       IF(IROT.NE.1)GO TO 400
  125.       CALL SETPT(20,169)
  126.       CALL TEXT10(CROT,14)
  127.       CALL SETPT(25,148)
  128.       CALL TEXT10(DIREC,1)
  129.       CALL ENF(ANTETA,DAT(1))
  130.       CALL SETPT(45,149)
  131.       IJJJ=1
  132.       CALL TEXT10(DAT,10)
  133.       IJJJ=0
  134.       CALL SETPT(0,143)
  135.       CALL LINA(223,143,1,0)
  136. 400   CONTINUE
  137.       IF(WHAT.EQ.UUU)GO TO 101
  138.       CALL SETPT(20,770)
  139.       CALL TEXT10(FSCAL,14)
  140.       CALL SETPT(34,743)
  141.       CALL ENF(SCALE,DAT(1))
  142.       IJJJ=1
  143.       CALL TEXT10(DAT(1),10)
  144.       IJJJ=0
  145. 101   CALL SETPT(0,738)
  146.       CALL LINA(223,738,1,0)
  147.       CALL SETPT(34,711)
  148.       CALL TEXT10       (PL(1),11)
  149.       DO 91 I=1,3
  150.       IY=757-51*I
  151.       CALL SETPT (20,IY)
  152.       CALL LINA   (203,IY,1,3434)
  153.       CALL SETPT(20,IY-37)
  154.       X=CL(I)
  155.       CALL TEXT10       (X,1)
  156.       CALL SETPT(62,IY-22)
  157.       CALL ENF (BL(2*I-1),DAT(1))
  158.       IJJJ=1
  159.       CALL TEXT10       (DAT(1),10)
  160.       CALL SETPT(62,IY-46)
  161.       CALL ENF (BL(2*I),DAT(1))
  162.       CALL TEXT10       (DAT(1),10)
  163.       IJJJ=0
  164. 91    CONTINUE
  165.       IJJJ=0
  166.       CALL SETPT(0,552)
  167.       CALL LINA(223,552,1,0)
  168.       IF(IST1.NE.1)GO TO 60
  169.       CALL SETPT(20,525)
  170.       CALL TEXT10(ARROW,11)
  171.       CALL SETPT(20,498)
  172.       CALL TEXT10(ONEIN,10)
  173.       CALL SETPT(41,460)
  174.       CALL ENF(SHOST,ASQ1)
  175.       IJJJ=1
  176.       CALL TEXT10(ASQ1,10)
  177.       IJJJ=0
  178.       GO TO 69
  179. 60    CALL SETPT(76,525)
  180.       CALL WDATE(DAT(1))
  181.       DAT(1)=DAT(3)
  182.       DAT(2)=DAT(4)
  183.       DAT(3)=DAT(6)
  184.       CALL TEXT10(DATE00,4)
  185.       I41=41
  186.       CALL SETPT(I41,498)
  187.       CALL TEXT10(DAT(1),10)
  188.       CALL SETPT(20,494)
  189.       CALL LINA(203,494,1,3434)
  190.       CALL SETPT(76,467)
  191.       CALL TEXT10(TIME00,4)
  192.       CALL SETPT(41,440)
  193.       CALL FDATE(TIMSS(1))
  194.       TIMSS(1)=TIMSS(3)
  195.       TIMSS(2)=TIMSS(4)
  196.       CALL TEXT10(TIMSS,8)
  197. 69    CALL SETPT(0,435)
  198.       CALL LINA(223,435,1,0)
  199.       CALL SETPT(20,408)
  200.       IF(MODEL1.NE.1)GO TO 134
  201.       DHI21=HI21
  202.       HI21=17.0
  203.       CALL TEXT10(MOD22,10)
  204.       HI21=DHI21
  205.       GO TO 131
  206. 134   CONTINUE
  207. 130   CALL TEXT10(SAP6,11)
  208. 131   CALL SETPT(20,381)
  209.       CALL TEXT10(USER,14)
  210.       CALL SETPT(20,354)
  211.       CALL TEXT10(USC,13)
  212.       CALL SETPT(20,327)
  213.       CALL TEXT10(CALIF,14)
  214. 800   CALL HOME
  215.       CALL OFFSET(0)
  216.       RETURN
  217.       END
  218.       FUNCTION LENSTR (CHAR,VAL)
  219.       INTEGER STRING(12),FIG(10),E,DOT,BLANK
  220.       LOGICAL*1 CHAR(12),W,BBBB
  221.       EQUIVALENCE (IPOS,W)
  222.       REAL DEC(5),FRACT(6)
  223.       DATA FIG/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/, E/1HE/, MINUS
  224.      1/1H-/, DOT/1H./, BLANK/1H /,DEC/1.,10.,100.,1000.,1.E4/,
  225.      1FRACT/.5,.05,.005,5.E-4,5.E-5,5.E-6/,
  226.      1BBBB/1H /
  227.       X=VAL
  228.       DO 2 MMM=1,12
  229. 2     CHAR(MMM)=BBBB
  230.       IND=1
  231.       IF (X.NE.0.) GO TO 11
  232.       STRING(IND)=FIG(1)
  233.       GO TO 999
  234. 11    Y=ABS(X)
  235.       IPOWER=0
  236.       IF (X.GT.0.) GO TO 22
  237.       STRING(IND)=MINUS
  238.       IND=IND+1
  239. 22    IF (Y.GE.1.) GO TO 33
  240. 44    X=Y*10.
  241.       IF (X.GE.1.) GO TO 60
  242.       IPOWER=IPOWER-1
  243.       Y=X
  244.       GO TO 44
  245. 33    IF (Y.LT.1.E5) GO TO 55
  246. 30    IPOWER=IPOWER+1
  247.       Y=Y/10.
  248.       IF (Y.GE.1.) GO TO 30
  249. 60    IPOS=0
  250.       Y=Y+FRACT(6)
  251.       IF (Y.GE.1.) IPOS=1
  252.       GO TO 66
  253. 55    IPOS=6
  254. 77    IPOS=IPOS-1
  255.       IF (Y.LT.DEC(IPOS)) GO TO 77
  256.       III=6-IPOS
  257.       Y=Y+FRACT(III)
  258.       IF (Y.GE.10.*DEC(IPOS)) IPOS=IPOS+1
  259.       IF (IPOS.LT.6) GO TO 66
  260.       IPOS=0
  261.       IPOWER=6
  262.       Y=Y/1.E6
  263. 66    IDIG=0
  264. 88    IF (IPOS.LT.1) GO TO 99
  265.       I=Y/DEC(IPOS)
  266.       STRING(IND)=FIG(I+1)
  267.       IND=IND+1
  268.       Y=Y-DEC(IPOS)*I
  269.       IDIG=IDIG+1
  270.       IPOS=IPOS-1
  271.       GO TO 88
  272. 99    CONTINUE
  273.       STRING(IND)=DOT
  274.       IND=IND+1
  275. 111   IF (IDIG.EQ.5) GO TO 122
  276.       Y=Y*10.
  277.       I=Y
  278.       STRING(IND)=FIG(I+1)
  279.       IND=IND+1
  280.       IDIG=IDIG+1
  281.       Y=Y-I
  282.       GO TO 111
  283. 122   IND=IND-1
  284.       I=STRING(IND)
  285.       IF (I.EQ.FIG(1)) GO TO 133
  286.       IF (I.NE.DOT) GO TO 144
  287.       STRING(IND)=BLANK
  288.       IND=IND-1
  289.       GO TO 144
  290. 133   STRING(IND)=BLANK
  291.       GO TO 122
  292. 144   IF (IPOWER.EQ.0) GO TO 999
  293.       X=IPOWER
  294.       STRING(IND+1)=E
  295.       IND=IND+2
  296.       GO TO 11
  297. 999   LENSTR=IND
  298.       IPOWER=(IND+3)/4*4
  299.       IF (IND.EQ.IPOWER) GO TO 888
  300.       IPOS=IND+1
  301.       DO 155 IDIG=IPOS,IPOWER
  302. 155   STRING(IDIG)=BLANK
  303. 888   DO 166 IDIG=1,IPOWER
  304.       IPOS=STRING(IDIG)
  305. 166   CHAR(IDIG)=W
  306.       RETURN
  307.       END
  308.       SUBROUTINE LINA (IX,IY,INT,LINTYP)
  309.       COMMON/HP21/IHP21,PAT
  310.       COMMON/CALCOM/ICAL
  311.       COMMON/IGL100/IGLKEY
  312.       COMMON/RAMTEK/MTEK1,SRAM1,XRAMT,YRAMT
  313.       IF(ICAL.EQ.1)GO TO 60
  314.       X=IX
  315.       LDHP=2
  316.       Y=IY
  317.       IF (INT .EQ. 1) GO TO 11
  318.       CALL MOVEA(X,Y)
  319.       RETURN
  320. 11    IF(LINTYP.EQ.0)GO TO 21
  321.       CALL DASHA(X,Y,LINTYP)
  322.       RETURN
  323. 21    CALL DRAWA(X,Y)
  324. 31    RETURN
  325. 60    X=IX
  326.       Y=IY
  327.       IF(INT.EQ.1)GO TO 61
  328.       IPEN=1
  329.       GO TO 65
  330. 61    IF(LINTYP.EQ.0)IPEN=2
  331.       IF(LINTYP.NE.0)IPEN=LINTYP
  332. 65    WRITE(10,66)IPEN,X,Y
  333. 66    FORMAT(I10,2F10.3)
  334.       RETURN
  335.       END
  336.       SUBROUTINE LINABS(IX,IY,I)
  337.       IF(I.EQ.1)CALL DRWABS(IX,IY)
  338.       IF(I.NE.1)CALL MOVABS(IX,IY)
  339.       RETURN
  340.       END
  341.       SUBROUTINE PLINE (IX,IY,INT)
  342.       COMMON/HP21/IHP21
  343.       COMMON/CALCOM/ICAL
  344.       COMMON/IGL100/IGLKEY
  345.       COMMON/BEAPOS/IX1,IY1
  346.       COMMON/RAMTEK/MTEK1,SRAM,XRAMT,YRAMT
  347.       X=IX
  348.       Y=IY
  349.       IF(ICAL.EQ.1)GO TO 40
  350.       IF (INT .EQ. 1) GO TO 11
  351.       CALL MOVER (X,Y)
  352.       RETURN
  353. 11    CALL DRAWR (X,Y)
  354.       RETURN
  355. 40    IF(INT.EQ.1)IPEN=4
  356.       IF(INT.NE.1)IPEN=3
  357.       WRITE(10,41)IPEN,X,Y
  358. 41    FORMAT(I10,2F10.3)
  359.       RETURN
  360.       END
  361.       SUBROUTINE LINREL(IX,IY,I)
  362.       COMMON/IGL100/IGLKEY
  363.       COMMON/STRCLR/ICLR
  364.       COMMON/IWINDO/IWIND,XM1,XM2,YM1,YM2,WINLEN
  365.       IF(I.EQ.1)GO TO 5
  366.       CALL MOVREL(IX,IY)
  367.       RETURN
  368. 5     IF(ICLR.EQ.1) GOTO 15
  369.       CALL DRWREL(IX,IY)
  370.       RETURN
  371. 15    CALL DRWREL1(IX,IY)
  372.       RETURN
  373.       END
  374.       SUBROUTINE MEROT(VC)
  375.       COMMON/ROTAT/IROT,TETA,DIREC
  376.       DIMENSION VC(3)
  377.       DATA XXX/1HX/,YYY/1HY/,ZZZ/1HZ/
  378.       X=VC(1)
  379.       Y=VC(2)
  380.       Z=VC(3)
  381.       IF(DIREC.EQ.XXX)GO TO 100
  382.       IF(DIREC.EQ.YYY)GO TO 200
  383.       IF(DIREC.EQ.ZZZ)GO TO 300
  384.       RETURN
  385. 100   ZT=Z*COS(TETA)-Y*SIN(TETA)
  386.       Y=Y*COS(TETA)+Z*SIN(TETA)
  387.       Z=ZT
  388.       GO TO 500
  389. 200   XT=X*COS(TETA)-Z*SIN(TETA)
  390.       Z=Z*COS(TETA)+X*SIN(TETA)
  391.       X=XT
  392.       GO TO 500
  393. 300   XT=X*COS(TETA)+Y*SIN(TETA)
  394.       Y=Y*COS(TETA)-X*SIN(TETA)
  395.       X=XT
  396. 500   VC(1)=X
  397.       VC(2)=Y
  398.       VC(3)=Z
  399.       RETURN
  400.       END
  401.       SUBROUTINE NODINP (NC,NUMNP,NP,ID,NZZ,ISAPP)
  402.       IMPLICIT REAL*8(A-H,O-Z)
  403.       COMMON/UNIT/II11,II22
  404.       DIMENSION ID(NZZ,3),XYZT(3)
  405.       COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1
  406.       COMMON/LFIRST/IFIRST
  407.       COMMON/IFORMT/IFORM
  408.       REAL*8  ID
  409.       COMMON/QTSARG/ X(3,50),Y(3,50),Z(3,50),TI(3,3,50),XC(3),XI(3)
  410.      1,XX(3),DX(3)
  411.      2,CORD(20,3),PERR,PERS,PERT,H(20),CZ(3)
  412.       DIMENSION NOD(8),N3D(20)
  413.       DATA IYES/1HY/,RRR/1HR/
  414. 20    KO=1
  415.       KS=0
  416.       IFIRST=0
  417.       IF(IFORM.EQ.0)READ(31)N
  418.       IF(IFORM.EQ.1)READ(31,800)N
  419. 800   FORMAT(5X,I5)
  420.       BACKSPACE 31
  421.       IF(N.LE.1)GO TO 56
  422.       IFIRST=N
  423. 56    KN=0
  424. 60    CONTINUE
  425.       IF(IFORM.EQ.0)READ(31)N
  426.       IF(IFORM.EQ.1)READ(31,800)N
  427. 76    FORMAT(I5)
  428. 510   IF(N.EQ.0) GO TO 270
  429.       IF(N.LT.0)GO TO 291
  430.       IF(IFORM.EQ.0) READ(31)XX
  431.       IF(IFORM.EQ.1)READ(31,131)XX
  432. 131   FORMAT(3E12.5)
  433. 515   IF(IFIRST.NE.0)N=N-IFIRST+1
  434.       KT=1
  435.       IF(N.GT.NUMNP) GO TO 280
  436. 230   KO=0
  437.       NI=N
  438.       DO 240 J=1,3
  439. 240   XI(J)=XX(J)
  440.       DO 241 J=1,3
  441.       XC(J)=XI(J)
  442. 241   CONTINUE
  443.       DO 260 I=1,3
  444. 260   ID(N,I)=XC(I)
  445.       GO TO 60
  446. 270   REWIND 28
  447.       WRITE (28) ((ID(I,J),J=1,3),I= 1,NUMNP)
  448.       RETURN
  449. 280   CONTINUE
  450.       WRITE(*,100)N
  451. 100   FORMAT('  *ERROR* NODE NUMBER = ',I5,' GREATER THAN TOTAL NODES')
  452.       STOP
  453. 291   WRITE(*,292)N
  454. 292   FORMAT('  *ERROR* NEGATIVE NODE NUMBER ',I6)
  455.       STOP
  456.       END
  457.         SUBROUTINE NOPL10
  458. CC-----------------------------------------------------------I
  459. CC      LINK POST WITH THIS SUBROUTINE IF YOU DO NOT HAVE    I
  460. CC      PLOT 10 (TCS) SUBROUTINES AND YOU HAVE IGL PLOT10    I
  461. CC-----------------------------------------------------------I
  462.         ENTRY ANMODE
  463.         ENTRY BELL
  464. C       ENTRY NEWPAG
  465.         ENTRY HOME
  466. C       ENTRY ANSTR
  467.         ENTRY CHRSIZ
  468.         ENTRY CSIZE
  469. C       ENTRY DASHA
  470. C       ENTRY DRAWA
  471. C       ENTRY DRAWR
  472. C       ENTRY DRWABS
  473. C       ENTRY DRWREL
  474. C       ENTRY DWINDO
  475. C       ENTRY ERASE
  476. C       ENTRY INITT
  477. C       ENTRY MOVABS
  478. C       ENTRY MOVEA
  479. C       ENTRY MOVER
  480. C       ENTRY MOVREL
  481. C       ENTRY POINTA
  482. C       ENTRY SWINDO
  483.         ENTRY TERM
  484. C       ENTRY TOUTPT
  485. C       ENTRY TWINDO
  486.         ENTRY V2ST
  487. C       ENTRY VCURSR
  488. C       ENTRY VWINDO
  489. CC ...HP PLOTTER
  490.         ENTRY ARCREL
  491.         ENTRY DASLNA
  492.         ENTRY LIMIT
  493.         ENTRY HPPLOTS
  494.         ENTRY PLOTS
  495.         ENTRY MAPUU
  496.         ENTRY NEWPEN
  497.         ENTRY PENUP
  498. C       ENTRY PLOT
  499.         ENTRY PLOTOF
  500.         ENTRY PLOTON
  501.         ENTRY IPLOT
  502.         ENTRY RPLOT
  503.         ENTRY SETIN
  504.         ENTRY SYMBOL
  505.         RETURN
  506.         END
  507.       SUBROUTINE OFFSET (I)
  508.       COMMON/LAB/ILAB
  509.       COMMON/IGL100/IGLKEY
  510.       COMMON/IWINDO/IWIND,XM1,XM2,YM1,YM2
  511.       COMMON/CALCOM/ICAL
  512.       IF(ICAL.EQ.1)GO TO 50
  513.       IF (I .EQ. 1) GO TO 11
  514.       CALL VWINDO (0.,800.,0.,800.)
  515.       IF(ILAB.EQ.0) GOTO 500
  516.       CALL SWINDO(0,1000,0,800)
  517.       GOTO 600
  518. 500   CALL SWINDO (0,800,0,800)
  519. 600   RETURN
  520. 11    CALL VWINDO (0.,223.,0.,800.)
  521.       CALL SWINDO (800,223,0,800)
  522.       RETURN
  523. 50    IF(I.EQ.1)GO TO 60
  524.       XORG=0.0
  525.       YORG=0.0
  526.       GO TO 62
  527. 60    XORG=800.0
  528.       YORG=0.0
  529. 62    IPEN=999
  530.       WRITE(10,63)IPEN,XORG,YORG
  531. 63    FORMAT(I10,2F10.3)
  532.       RETURN
  533.       END
  534.       SUBROUTINE PPAUSE(IO,IN)
  535.       DATA BL/1H /
  536.       WRITE(IO,2000)
  537. 2000  FORMAT(/'   **** PRESS <RETURN> TO CONTINUE:')
  538.       READ(IN,1000)A
  539. 1000  FORMAT(A1)
  540.       RETURN
  541.       END
  542.       SUBROUTINE NICEY(YMIN,YMAX,NTY)
  543.       YMAX1=ABS(YMIN)
  544.       YMAX2=ABS(YMAX)
  545.       YMAXMX=YMAX1
  546.       IF(YMAX2.GT.YMAXMX)YMAXMX=YMAX2
  547.       FACTOR=1.
  548.       YMAXSC=YMAXMX
  549. 90    IF(YMAXSC.LE.10.)GO TO 100
  550.       FACTOR =0.1*FACTOR
  551.       YMAXSC=FACTOR*YMAXMX
  552.       GO TO 90
  553. 100   IF(YMAXSC.GE.10.)GO TO 110
  554.       FACTOR=10.*FACTOR
  555.       YMAXSC=FACTOR*YMAXMX
  556.       GO TO 100
  557. 110   MAXSC=YMAXSC/10.
  558.       MAXNOR=MAXSC*10+10
  559.       IF(MAXNOR.EQ.20)NTY=41
  560.       IF(MAXNOR.EQ.30)NTY=61
  561.       IF(MAXNOR.EQ.40)NTY=41
  562.       IF(MAXNOR.EQ.50)NTY=51
  563.       IF(MAXNOR.EQ.60)NTY=61
  564.       IF(MAXNOR.EQ.70)MAXNOR=80
  565.       IF(MAXNOR.EQ.80)NTY=41
  566.       IF(MAXNOR.EQ.90)MAXNOR=100
  567.       IF(MAXNOR.EQ.100)NTY=51
  568.       YMAXPT=MAXNOR
  569.       YNICE=YMAXPT/FACTOR
  570.       YMIN=-YNICE
  571.       YMAX=+YNICE
  572.       RETURN
  573.       END
  574.       SUBROUTINE PPOINT(X,Y,LTYPE1)
  575.       COMMON/IGL100/IGLKEY
  576.       KEY=LTYPE1+1
  577.       IF(KEY.LT.1)GO TO 1
  578.       IF(KEY.GT.10)GO TO 10
  579.       GO TO (1,2,3,4,5,6,7,8,9,10),KEY
  580. 1     CALL DRAWA(X,Y)
  581.       RETURN
  582. 2     CALL DASHA(X,Y,1414)
  583.       RETURN
  584. 3     CALL DASHA(X,Y,3434)
  585.       RETURN
  586. 4     CALL DASHA(X,Y,5454)
  587.       RETURN
  588. 5     CALL DASHA(X,Y,5212)
  589.       RETURN
  590. 6     CALL DASHA(X,Y,5232)
  591.       RETURN
  592. 7     CALL DASHA(X,Y,5414145)
  593.       RETURN
  594. 8     CALL DASHA(X,Y,5656)
  595.       RETURN
  596. 9     CALL DASHA(X,Y,521215)
  597.       RETURN
  598. 10    CALL DASHA(X,Y,3636)
  599.       RETURN
  600.       END
  601.