home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e003 / 13.ddi / PO5.FOR < prev    next >
Encoding:
Text File  |  1987-10-29  |  12.5 KB  |  507 lines
  1.       SUBROUTINE PLTAXS (IM,SC)
  2.       DIMENSION IC(2,3),VC(3),CL(3),XL(3)
  3.       COMMON /BX/BM(3)
  4.       COMMON/RAMTEK/MTEK1
  5.       COMMON/HP21/IHP21,PAT,HI21,X21,Y21
  6.       DATA CL,XL/1HX,1HY,1HZ,4HMODL,4HDEFL,4HLOAD/
  7.       NP=0
  8.       SCALE=0.
  9.       IF (SC .EQ. 0.) GO TO 41
  10.       SCALE=55./ABS(SC)
  11. 11    IF (SCALE .GE. 1.) GO TO 21
  12.       SCALE=SCALE*10.
  13.       NP=NP+1
  14.       FAC=.1
  15.       GO TO 11
  16. 21    IF (SCALE .LT. 10.) GO TO 31
  17.       SCALE=0.1*SCALE
  18.       NP=NP+1
  19.       FAC=10.
  20.       GO TO 21
  21. 31    IF(FAC.EQ.0.0)FAC=1.0
  22.       SCALE=FLOAT(IFIX(SCALE+0.5))*SC/ABS(SC)*FAC**NP
  23. 41    CALL SCNCD (BM,X,Y)
  24.       DO 61 I=1,3
  25.       DO 51 J=1,3
  26. 51    VC(J)=BM(J)
  27.       VC(I)=VC(I)+1.
  28.       CALL SCNCD (VC,X1,Y1)
  29.       IC(1,I)=(X1-X)*SC*SCALE
  30. 61    IC(2,I)=(Y1-Y)*SC*SCALE
  31.       IX=0
  32.       IY=0
  33.       IX1=0
  34.       IY1=0
  35.       DO 71 I=1,3
  36.       IF (IC(1,I) .LT. IX) IX=IC(1,I)
  37.       IF (IC(2,I) .LT. IY) IY=IC(2,I)
  38.       IF (IC(1,I) .GT. IX1) IX1=IC(1,I)
  39.       IF (IC(2,I) .GT. IY1) IY1=IC(2,I)
  40. 71    CONTINUE
  41. 81    IDX=70-IX
  42.       IDY=55-IY
  43.       IX1=4
  44.       IX=4
  45.       DO 121 I=1,3
  46.       CALL SETPT (IDX,IDY)
  47.       CALL PLINE(IC(1,I),IC(2,I),1)
  48.       CALL PLINE(4,-7,0)
  49. 55    X=CL(I)
  50. 121   CALL TEXT10(X,1)
  51.       RETURN
  52.       END
  53.       SUBROUTINE PROUT(KK,ID,ID2,ID3,ID4,NUMNP,NUMEL,NUMEL2,NADND,NADEL,
  54.      1NDKOD,NDMX,IES,NRES,NE35,ND35)
  55.       IMPLICIT REAL*8(A-H,O-Z)
  56.       REAL SNGX(3)
  57.       REAL*8  ID,ID2,ID3
  58.       REAL*8  ID4
  59.       DIMENSION ID(NUMNP,3),ID2(NUMEL,5),ID3(  1,9)
  60.       DIMENSION ID4(NE35,ND35)
  61.       COMMON/ELARRY/NELAR(4,20)
  62.       COMMON/PREP/XMX,XAD,KSKIP,NDYN,I1
  63.       COMMON /TRASH/IA(20),ND(100)
  64.       COMMON/JUNK/X(3),CX(6),DX(8),IX(8),JX(5),I,IXX(16),JXX(4), KX(12)
  65.       COMMON/PLOTH/NCPT
  66.       DIMENSION C(8),G(3)
  67.       DATA  C/2HDX,2HDY,2HDZ,2HRX,2HRY,2HRZ,2H  ,2H**/
  68.       DATA G/2HNM,2HND,2HNR/
  69.       NDD=6
  70.       NCPT=0
  71.       NELMX=0
  72.       NDIFMX=0
  73.       IU=19
  74.       KP=0
  75.       IF(KK.GT.4)KP=1
  76.       IF(KK.GT.4)KK=KK/10
  77.       GO TO (10,100,250,260),KK
  78. 10    REWIND 28
  79.       READ  (28) ((ID(I,J),J=1,3),I=1,NUMNP)
  80.       IF(NRES.EQ.12) GO TO 20
  81.       WRITE (NRES) ((ID(I,J),J=1,3),I=1,NUMNP)
  82. 20    CONTINUE
  83.       REWIND 19
  84.       DO 90 N=1,NUMNP
  85.       DO 30 I=1,NDD
  86. 30    CX(I)=C(7)
  87.       MP= MOD(N,2)
  88.       MP=3-3*MP
  89.       MP2=2*MP
  90.       DO 40 I=1,3
  91.       NNN=ID(N,I)
  92.       IF(NNN.LT.0) NNN=NNN-1
  93.       X(I)= ID(N,I)
  94.       DX(I+MP)=X(I)
  95.       NN1= MOD(NNN,I1)
  96.       NN2=NNN/I1
  97.       KX(I+MP2)=NN1
  98.       IF(NN1.GE.10) KX(I+MP2)=0
  99.       KX(I+MP2+3)=NN2
  100.       IF(NN1.GT.0) CX(I)=C(I)
  101.       IF(NN1.GE.100) CX(I)=C(8)
  102.       IF(NN2.GT.0) CX(I+3)=C(I+3)
  103.       IF(NN1.LT.0) CX(I+3)=C(I+3)
  104. 40    CONTINUE
  105.       NI=N-1
  106.       IF(N.EQ.NUMNP.AND.MP.EQ.0) NI=N
  107.       IF(N.EQ.NUMNP)  MP=6
  108.       DO 50 I=1,3
  109.       SNGX(I)=SNGL(X(I))
  110. 50    CONTINUE
  111.       WRITE(19)SNGX
  112.       IF(MOD(N,2)) 70,80,70
  113. 70    CONTINUE
  114.       GO TO 90
  115. 80    CONTINUE
  116. 90    CONTINUE
  117.       RETURN
  118. 100   I444=4
  119.       REWIND I444
  120.       READ  (I444) ((ID2(I,J),J=1,5),I=1,NUMEL)
  121.       IF(NDKOD.EQ.1)READ(I444) ((ID4(I,J),J=1,NADND),I=1,NUMEL)
  122.       IF(NRES.EQ.12) GO TO 110
  123.       WRITE (NRES) ((ID2(I,J),J=1,5),I=1,NUMEL)
  124.       IF(NDKOD.EQ.1) WRITE(NRES) ((ID4(I,J),J=1,NADND),I=1,NUMEL)
  125. 110   CONTINUE
  126.       DO 240 I=1,NUMEL
  127.       DO 120 J=1,4
  128.       NN=ID2(I,J)
  129.       IX(J+4)=NN/I1
  130. 120   IX(J)= MOD(NN,I1)
  131.       XM=100
  132.       T=ID2(I,5)
  133.       DO 130 J=1,5
  134.       JX(J)=DMOD(T,XM)
  135. 130   T= T/XM
  136.       MIN=100000
  137.       MAX=0
  138.       MP= MOD(I,2)
  139.       MP=8-8*MP
  140.       MT=JX(5)
  141.       DO 140 J=1,8
  142.       IXX(J+MP)=IX(J)
  143.       IF(IX(J).EQ.0) GO TO 140
  144.       IF(J.GT.NELAR(2,MT)) GO TO 140
  145.       IF(IX(J).GT.MAX) MAX=IX(J)
  146.       IF(IX(J).LT.MIN) MIN=IX(J)
  147. 140   CONTINUE
  148.       NDIF=MAX-MIN
  149.       IF(MT.EQ.7) NDIF=0
  150.       MP=MP/4
  151.       JXX(1+MP)=JX(5)
  152.       JXX(2+MP)=JX(1)
  153.       NI=I-1
  154.       IF(I.EQ.NUMEL.AND.MP.EQ.0) NI=I
  155.       IF(I.EQ.NUMEL) MP=2
  156.       IF(KP.EQ.1.AND.NDKOD.EQ.1) KP=2
  157.       IF(NDKOD.EQ.0.OR.NDMX.LE.8) GO TO 230
  158.       MT=JX(5)
  159.       DO 180 J=9,20
  160. 180   IA(J)=0
  161.       IF(NELAR(1,MT).LE.8) GO TO 210
  162.       XM=10000
  163.       DO 190 J=1,NADND
  164.       T=ID4(I,J)
  165.       MP=3*(J-1)+8
  166.       DO 190 K=1,3
  167.       MP=MP+1
  168.       IA(MP)=DMOD(T,XM)
  169. 190   T=T/XM
  170.       DO 200 J=9,NDMX
  171.       IF(IA(J).EQ.0) GO TO 200
  172.       IF(IA(J).GT.MAX) MAX=IA(J)
  173.       IF(IA(J).LT.MIN) MIN=IA(J)
  174. 200   CONTINUE
  175.       NDIF=MAX-MIN
  176. 210   CONTINUE
  177.       MT=JX(5)
  178. 230   CONTINUE
  179.       ITYPE=JX(5)
  180.       CALL PLOTDT(ITYPE,IX,IA,NCP)
  181.       NCPT=NCPT+NCP
  182.       IF(NDIF.GT.NDIFMX) NELMX=I
  183.       IF(NDIF.GT.NDIFMX) NDIFMX=NDIF
  184. 240   CONTINUE
  185.       KP=0
  186.       WRITE(19)KP
  187.       REWIND 18
  188.       WRITE(18)NUMNP,NUMEL,NCPT
  189. 250   RETURN
  190. 260   CONTINUE
  191.       RETURN
  192.       END
  193.       SUBROUTINE PSTRES(IX,IY,SIG)
  194.       COMMON/STRESS/IFLOK,IST1,SCL1,NSIG,IDIR
  195.       COMMON/VS11VA/IVS11,IMOVE,NNSTEP
  196.       COMMON/UNIT/II11,II22
  197.       COMMON/RAMTEK/MTEK1,RAMSCL
  198.       COMMON/MSTREE/STRPOS,STRNEG,KALOR,NCOL
  199.       COMMON/HP21/IHP21,PAT,HI21,X21,Y21
  200.       DATA IVVV/1HV/
  201.       X=FLOAT(IX)
  202.       Y=FLOAT(IY)
  203.       ST=SIG*SCL1
  204.       IF(ABS(ST).LT.2.)RETURN
  205.       ST=ABS(ST)
  206.       BR=ST/2.0
  207.       AR=ST/4.0
  208.       HR=ST/10.0
  209.       ZERO=0.0
  210.       IPEN=2
  211.       CALL SETPT(IX,IY)
  212.       IF(IDIR.EQ.IVVV)GO TO 100
  213.       IF(SIG.LT.0.0)GO TO 50
  214.       CALL PUTAR(BR,ZERO,IPEN)
  215.       CALL PUTAR(-AR,HR,IPEN)
  216.       CALL PUTAR(ZERO,-2.*HR,IPEN)
  217.       CALL PUTAR(AR,HR,IPEN)
  218.       CALL PUTAR(-ST,ZERO,IPEN)
  219.       CALL PUTAR(AR,HR,IPEN)
  220.       CALL PUTAR(ZERO,-2.*HR,IPEN)
  221.       CALL PUTAR(-AR,HR,IPEN)
  222.       RETURN
  223. 50    CALL PUTAR(BR,ZERO,IPEN)
  224.       CALL PUTAR(ZERO,HR,IPEN)
  225.       CALL PUTAR(-AR,-HR,IPEN)
  226.       CALL PUTAR(AR,-HR,IPEN)
  227.       CALL PUTAR(ZERO,HR,IPEN)
  228.       CALL PUTAR(-ST,ZERO,IPEN)
  229.       CALL PUTAR(ZERO,HR,IPEN)
  230.       CALL PUTAR(AR,-HR,IPEN)
  231.       CALL PUTAR(-AR,-HR,IPEN)
  232.       CALL PUTAR(ZERO,HR,IPEN)
  233.       RETURN
  234. 100   IF(SIG.LT.0.0)GO TO 300
  235.       CALL PUTAR(ZERO,BR,IPEN)
  236.       CALL PUTAR(HR,-AR,IPEN)
  237.       CALL PUTAR(-2.*HR,ZERO,IPEN)
  238.       CALL PUTAR(HR,AR,IPEN)
  239.       CALL PUTAR(ZERO,-ST,IPEN)
  240.       CALL PUTAR(HR,AR,IPEN)
  241.       CALL PUTAR(-2.*HR,ZERO,IPEN)
  242.       CALL PUTAR(HR,-AR,IPEN)
  243.       RETURN
  244. 300   CALL PUTAR(ZERO,BR,IPEN)
  245.       CALL PUTAR(HR,ZERO,IPEN)
  246.       CALL PUTAR(-HR,-AR,IPEN)
  247.       CALL PUTAR(-HR,AR,IPEN)
  248.       CALL PUTAR(HR,ZERO,IPEN)
  249.       CALL PUTAR(ZERO,-ST,IPEN)
  250.       CALL PUTAR(HR,ZERO,IPEN)
  251.       CALL PUTAR(-HR,AR,IPEN)
  252.       CALL PUTAR(-HR,-AR,IPEN)
  253.       CALL PUTAR(HR,ZERO,IPEN)
  254.       RETURN
  255.       END
  256.       SUBROUTINE PUTAR(DX,DY,IPEN)
  257.       COMMON/HP21/IHP21,PAT,HI21,X21,Y21
  258.       COMMON/CALCOM/ICAL
  259.       COMMON/STRCLR/ICLR
  260.       IF(ICAL.EQ.1) GOTO 100
  261.       IDX=IFIX(DX)
  262.       IDY=IFIX(DY)
  263.       ICLR=1
  264.       IF(IPEN.EQ.3) CALL LINREL (IDX,IDY,0)
  265.       IF(IPEN.EQ.2) CALL LINREL (IDX,IDY,1)
  266.       GOTO 120
  267. 100   IF(IPEN.EQ.3)IPN=5
  268.       IF(IPEN.EQ.2)IPN=6
  269.       WRITE(10,110)IPN,DX,DY
  270. 110   FORMAT(I10,2F10.3)
  271. 120   RETURN
  272.       END
  273.       SUBROUTINE QUADN(ISX,ISY,IN,I)
  274.       COMMON/IWINDO/IWIND,XM1,XM2,YM1,YM2
  275.       COMMON/CALCOM/ICAL
  276.       IP1=1
  277.       IP2=2
  278.       SX=ISX
  279.       SY=ISY
  280.       CALL CSIZE(IHORZ,IVERT)
  281.       IF(IHORZ.LE.0)IHORZ=14
  282.       IF(IVERT.LE.0)IVERT=22
  283.       XJ24=9.*FLOAT(IVERT)/8.0
  284.       XJ17=5.*FLOAT(IHORZ)/4.0
  285.       H=XJ24
  286.       WI=XJ17
  287.       W=2.*WI
  288.       IF(I.LT.1000)W=3.*WI/2.
  289.       IF(I.LT.100)W=WI
  290.       IF(I.LT.10)W=WI/2.
  291.       CALL V2ST(1,SX,SY,LX,LY)
  292.       LX=LX-W
  293.       ALX=LX
  294.       LY=LY-H/2.
  295.       ALY=LY
  296.       CALL MOVABS(LX,LY)
  297.       IF(ICAL.EQ.1)WRITE(10,10)IP1,ALX,ALY
  298.       LY=LY+H
  299.       ALY=LY
  300.       CALL DRWABS(LX,LY)
  301.       IF(ICAL.EQ.1)WRITE(10,10)IP2,ALX,ALY
  302.       D=4.
  303.       IF(I.LT.1000)D=3.
  304.       IF(I.LT.100)D=2.
  305.       IF(I.LT.10)D=1.
  306.       LX=LX+D*WI
  307.       ALX=LX
  308.       CALL DRWABS(LX,LY)
  309.       IF(ICAL.EQ.1)WRITE(10,10)IP2,ALX,ALY
  310.       LY=LY-H
  311.       ALY=LY
  312.       CALL DRWABS(LX,LY)
  313.       IF(ICAL.EQ.1)WRITE(10,10)IP2,ALX,ALY
  314.       LX=LX-D*WI
  315.       ALX=LX
  316.       CALL DRWABS(LX,LY)
  317.       IF(ICAL.EQ.1)WRITE(10,10)IP2,ALX,ALY
  318. 10    FORMAT(I10,2F10.3)
  319.       RETURN
  320.       END
  321.       SUBROUTINE READST(IOK1)
  322.       COMMON/STRESS/IFLOK,IST1,SCL1,NSIG,IDIR,SHOST,SIGX(3000)
  323.       COMMON/NSAP6/ISAP6,LOAD6
  324.       COMMON/UNIT/II11,II22
  325.       COMMON/MSTREE/STRPOS,STRNEG,KALOR,NCOL
  326.       COMMON/ELRANG/IRANG
  327.       COMMON/RAMTEK/MTEK1
  328.       DIMENSION DUM(10)
  329.       IOK1=0
  330.       XNCOL=FLOAT(NCOL)
  331.       IF(LOAD6.EQ.0)LOAD6=1
  332.       REWIND 35
  333.       IBO=0
  334.       XMAX=0.0
  335.       STRMAX=0.0
  336.       STRMIN=0.0
  337.       IF(NSIG.GT.10.OR.NSIG.LT.1)GO TO 100
  338.       I=1
  339. 8     READ(35,20,END=300,ERR=30)N,LTYP,LD,(DUM(J),J=1,10)
  340. 20    FORMAT(3I5,10E10.3)
  341.       IF(LD.EQ.LOAD6)GO TO 22
  342.       GO TO 8
  343. 22    IF(IRANG.NE.1)GO TO 24
  344.       CALL SEELM1(N,IKOB)
  345.       IF(IKOB.NE.1)GO TO 26
  346. 24    XD=ABS(DUM(NSIG))
  347.       IF(DUM(NSIG).GT.STRMAX)STRMAX=DUM(NSIG)
  348.       IF(DUM(NSIG).LT.STRMIN)STRMIN=DUM(NSIG)
  349.       IF(XD.GT.XMAX)XMAX=XD
  350.       SIGX(I)=DUM(NSIG)
  351. 26    I=I+1
  352.       IBO=1
  353.       GO TO 8
  354. 300   IF(IBO.EQ.1)GO TO 120
  355.       WRITE(*,40)LOAD6
  356. 40    FORMAT('  STRESS FOR LOAD CASE =',I5,'  DOES NOT EXIST')
  357.       RETURN
  358. 120   SCL1=90./XMAX
  359.       SHOST=ABS(XMAX)*80.0/63.0
  360.       IOK1=1
  361.       STRPOS=STRMAX/XNCOL
  362.       STRNEG=STRMIN/XNCOL
  363.       RETURN
  364. 30    WRITE(*,444)
  365. 444   FORMAT(' INPUT CONVERSION ERROR ON UNIT 35 ')
  366. 100   IOK1=0
  367.       RETURN
  368.       END
  369.       SUBROUTINE SCALEM
  370.       DIMENSION VC(3)
  371.       COMMON /PLT/IPN,IEN,ILN,XB,YB,SC
  372.       COMMON /BX/BM(3),BL(6)
  373.       XMX=-1.E20
  374.       YMX=-1.E20
  375.       XMN=1.E20
  376.       YMN=1.E20
  377.       DO 11 I=1,2
  378.       DO 11 J=3,4
  379.       DO 11 K=5,6
  380.       VC(1)=BL(I)
  381.       VC(2)=BL(J)
  382.       VC(3)=BL(K)
  383.       CALL SCNCD (VC,XB,YB)
  384.       IF (XB .LT. XMN) XMN=XB
  385.       IF (XB .GT. XMX) XMX=XB
  386.       IF (YB .LT. YMN) YMN=YB
  387.       IF (YB .GT. YMX) YMX=YB
  388. 11    CONTINUE
  389.       XB=.5*(XMN+XMX)
  390.       YB=.5*(YMN+YMX)
  391.       SC=XMX-XMN
  392.       IF (SC .EQ. 0.) SC=.01
  393.       SC1=YMX-YMN
  394.       IF (SC1 .EQ. 0.) SC1=.01
  395.       SC=700./SC
  396.       SC1=700./SC1
  397.       IF (SC1 .LT. SC) SC=SC1
  398.       RETURN
  399.       END
  400.       SUBROUTINE SCNCD (VC,XC,YC)
  401.       COMMON/ROTAT/IROT
  402.       DIMENSION VC(3),V(3)
  403.       COMMON /BX/BM(3)
  404.       COMMON /ANG/H,SX,SY,CX,CY
  405.       DO 11 I=1,3
  406. 11    V(I)=VC(I)-BM(I)
  407.       IF(IROT.EQ.1)CALL MEROT(V)
  408.       D=1.+(SY*CX*V(1)-SX*V(2)-CX*CY*V(3))/H
  409.       XC=(CY*V(1)+SY*V(3))/D
  410.       YC=(SX*SY*V(1)+CX*V(2)-SX*CY*V(3))/D
  411.       RETURN
  412.       END
  413.       SUBROUTINE SEELM1(I,IOK)
  414.       COMMON/ELRANG/IRANG,IR0(2,10)
  415.       IOK=0
  416.       DO 100 J=1,10
  417.       DO 10 K=1,2
  418.       IF(IR0(K,J).LE.0)GO TO 100
  419. 10    CONTINUE
  420.       IF(I.GE.IR0(1,J).AND.I.LE.IR0(2,J))GO TO 200
  421.       IF(I.LE.IR0(1,J).AND.I.GE.IR0(2,J))GO TO 200
  422. 100   CONTINUE
  423.       RETURN
  424. 200   IOK=1
  425.       RETURN
  426.       END
  427.       SUBROUTINE SEEND1(I,IOK)
  428.       COMMON/SENOD1/ISEND,IR0(2,10)
  429.       COMMON/HIDDEN/IHIDE,NTHIDE,NHIDE(2000)
  430.       IOK=0
  431.       IF(IHIDE.EQ.1)GO TO 300
  432. 50    DO 100 J=1,10
  433.       DO 10 K=1,2
  434.       IF(IR0(K,J).LE.0)GO TO 100
  435. 10    CONTINUE
  436.       IF(I.GE.IR0(1,J).AND.I.LE.IR0(2,J))GO TO 200
  437.       IF(I.LE.IR0(1,J).AND.I.GE.IR0(2,J))GO TO 200
  438. 100   CONTINUE
  439.       RETURN
  440. 200   IOK=1
  441.       RETURN
  442. 300   IF(NTHIDE.LE.0)GO TO 320
  443.       DO 310 J=1,NTHIDE
  444.       IF(NHIDE(J).LE.0)GO TO 310
  445.       IF(I.EQ.NHIDE(J))GO TO 320
  446. 310   CONTINUE
  447.       IOK=1
  448. 315   IF(ISEND.EQ.1)GO TO 50
  449.       RETURN
  450. 320   IOK=0
  451.       GO TO 315
  452.       END
  453.       SUBROUTINE SETPT (IX,IY)
  454.       COMMON/HP21/IHP21
  455.       COMMON/CALCOM/ICAL
  456.       COMMON/IGL100/IGLKEY
  457.       COMMON/RAMTEK/MTEK1,SXRAM,XRAMT,YRAMT
  458.       X=IX
  459.       Y=IY
  460.       LINTYP=0
  461.       IPEN=0
  462.       IF(ICAL.EQ.1)GO TO 20
  463.       CALL MOVEA(X,Y)
  464.       RETURN
  465. 20    IPN=1
  466.       WRITE(10,21)IPN,X,Y
  467. 21    FORMAT(I10,2F10.3)
  468.       RETURN
  469.       END
  470.       SUBROUTINE TEXT10(NADE,NCHAR)
  471.       COMMON/BEAPOS/IX,IY
  472.       DIMENSION NADE(1)
  473.       NW=NCHAR/4
  474.       NW1=NW*4
  475.       IF (NW1.NE.NCHAR)NW=NW+1
  476.       CALL TEXTAM(NCHAR,NW,NADE)
  477.       RETURN
  478.       END
  479.       SUBROUTINE TEXTAM(NCHAR,NW,NAME)
  480.       COMMON/BEAPOS/IX1,IY1
  481.       COMMON/UNIT/II11,II22
  482.       COMMON/HP21/IHP21,PAT,HI21,X21,Y21
  483.       COMMON/CALCOM/ICAL
  484.       COMMON/RAMTEK/MTEK1
  485.       DIMENSION NAME(NW),DUM(80)
  486.       DATA BRAKE/1H!/,COEST/1H|/
  487.       I21=21
  488.       IF(ICAL.EQ.1)GO TO 20
  489.       CALL ANSTR(NCHAR,NAME,NW)
  490.       RETURN
  491. 20    NC1=-NCHAR
  492.       WRITE(10,24)NC1,X21,Y21
  493. 21    FORMAT(I10)
  494.       WRITE(10,25)NAME
  495. 25    FORMAT(2X,15A4)
  496. 24    FORMAT(I10,2F10.3)
  497.       RETURN
  498.       END
  499.       SUBROUTINE TTT
  500.       ENTRY FDATE
  501.       ENTRY WDATE
  502.       ENTRY STIME
  503.       ENTRY TTIME
  504.       ENTRY SECOND
  505.       RETURN
  506.       END
  507.