      SUBROUTINE ELTPLT(NLCP,NDF,MAXL,NGPT,NELT,NCP,LCP,X,Y,Z,DNX,DNY,
     1DNZ,LCDX,LCDY,IBC,IWTYP,NEXT)
      LOGICAL RGET,IGET
      COMMON/CALCOM/ICAL,XSIZE,YSIZE
      COMMON/UNIT/II11,II22
      COMMON/IGL100/IGLKEY
      DIMENSION NCP(NELT),LCP(NLCP),X(NGPT),Y(NGPT),Z(NGPT)
     1,LCDX(NGPT),LCDY(NGPT),IBC(NGPT)
     2,DNX(NDF),DNY(NDF),DNZ(NDF),IWTYP(NELT)
      COMMON /MES/L(10),V(10),I,IS,IERR
      COMMON/LFIRST/IFIRST
      COMMON/HP21/IHP21
      COMMON /PT/NU,NS,VC(3)
      COMMON/IWINDO/IWIND,XM1,XM2,YM1,YM2
      COMMON /PLT/IPN,IEN,ILN,XB,YB,SC,SCL,SCD,SCFL,SCFD,ISR,INR,LABL
     1,TYPEU,TYPED,WHAT,LNTYPD,LNTYPU,SCALE,IBCS,IPOINT,ILOAD
      COMMON /BX/BM(3),BL(6),BLS(6)
      COMMON/LAB/ILAB
      COMMON /ANG/H,SX,SY,CX,CY,IDC(3)
      DATA UUU/1HU/,DDD/1HD/,BBB/1HB/
11    IF(NEXT.EQ.0)CALL INITM(NGPT,NELT,X,Y,Z)
      NEXT=0
21    CALL COMM
      IF(I.EQ.17.OR.I.EQ.30)GO TO 200
      IF(I.EQ.26)GO TO 61
      GO TO (31,41,51,54,61,71,81,11,91,101,111,121,131),I
31    IPN=-IPN
      GO TO 21
41    IEN=-IEN
      GO TO 21
51    ILN=-ILN
      GO TO 21
54    IPOINT=-IPOINT
      GO TO 21
61    CALL ANGS
      IF(IHP21.EQ.1)IHP21=-3
      CALL SCALEM
62    CALL ERASE
63    CALL AXESPT
      IF(IHP21.EQ.-3)IHP21=1
      GO TO 21
71    CALL BOX
      GO TO 21
81    H=V(1)
      GO TO 21
91    CALL SCALEM
      ZERO=0.0
      IZERO=0
      IF(ICAL.EQ.1)WRITE(*,93)
      IF(ICAL.EQ.1)WRITE(10,95)IZERO,XSIZE,YSIZE
95    FORMAT(I10,2F10.3)
      CALL PLOTM(NLCP,NDF,NGPT,NELT,NCP,LCP,X,Y,Z,DNX,DNY,DNZ,MAXL
     1,LCDX,LCDY,IBC,IWTYP)
93    FORMAT(' START CREATING PLOT FILE FOR CALCOMP PLOTTER')
      IF(ICAL.EQ.1)WRITE(10,95)IZERO,ZERO,ZERO
      IF(ICAL.EQ.1)WRITE(*,96)
96    FORMAT(' CALCOMP FILE IS CREATED')
94    FORMAT(I10)
      CALL DWINDO(XM1,XM2,YM1,YM2)
      GO TO 21
101   RETURN
111   LABL=-LABL
      GO TO 21
121   SCALE=V(1)
      GO TO 21
131   IBCS=-IBCS
      GO TO 21
200   WRITE(*,201)
201   FORMAT(' INPUT NODE NUMBER ,0 TERMINATE')
202   WRITE(*,203)
203   FORMAT(2H ?)
210   CALL GETNL(GET001)
      IF(IGET(NONO))GO TO 210
      IF(NONO.LE.0)GO TO 21
      IF(IFIRST.NE.0)NONO=NONO-IFIRST+1
      IF(NONO.GT.NGPT)GO TO 230
      IF(I.EQ.30)GO TO 710
      WRITE(*,228)
228   FORMAT(' --- UNDEFORMED SHAPE ---')
      WRITE(*,220)NONO,X(NONO),Y(NONO),Z(NONO)
220   FORMAT('  NODE =',I5,'  X= ',E12.5,'  Y= ',E12.5,'  Z= ',E12.5)
      IF(WHAT.EQ.UUU)GO TO 202
      WRITE(*,240)
240   FORMAT(' +++ DISPLACEMENTS +++')
      WRITE(*,220)NONO,DNX(NONO),DNY(NONO),DNZ(NONO)
      GO TO 202
230   WRITE(*,231)NONO
231   FORMAT(' NODE =',I5,' DOES NOT EXIST ')
      GO TO 202
710   WRITE(*,711)NONO,X(NONO),Y(NONO),Z(NONO)
711   FORMAT(10X,' NODE NUMBER =',I5,' PRESENT COORDINATES'
     1,/,20X,'X = ',F15.5,1X,' Y = ',F15.5,1X,' Z = ',F15.5)
713   WRITE(*,712)
712   FORMAT(16X,'NEW X =')
      CALL GETNL(GET001)
      IF(RGET(XDUM))GO TO 714
      X(NONO)=XDUM
714   WRITE(*,715)
715   FORMAT(16X,'NEW Y = ')
      CALL GETNL(GET001)
      IF(RGET(YDUM))GO TO 716
      Y(NONO)=YDUM
716   WRITE(*,717)
717   FORMAT(16X,'NEW Z = ')
      CALL GETNL(GET001)
      IF(RGET(ZDUM))GO TO 200
      Z(NONO)=ZDUM
      GO TO 200
      END
      SUBROUTINE ENF(V,T)
      DIMENSION T(3)
      KK=LENSTR(T,V)
      RETURN
      END
      SUBROUTINE ENF1(I,M)
      DIMENSION M(1)
      XX=FLOAT(I)
      KK=LENSTR(M,XX)
      RETURN
      END
      SUBROUTINE ERROR(I)
      COMMON/UNIT/II11,II22
      J=IABS(I)
      WRITE(*,10)J
10    FORMAT(' ***** INCREASE THE MTOT IN POST PROGRAM BY =',I6)
      RETURN
      END
      SUBROUTINE FINODE(K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      COMMON/MES/L(10)
      COMMON/HIDDEN/I123,J123,NHID1(3000)
      COMMON/PLT/I01,I02,I03,XBB,YBB,SCC
      COMMON/KAMY/MXNDNM,NUMNP,NEL,VX,VY,VZ,
     $IPOINT,S,F,D,
     $ID(20),RESULT,XKS(4),YKS(4),ZKS(4),ZSS
      COMMON/ELRANG/IRANG
      DIMENSION VCC(3)
      DIMENSION XE(K0),YE(K0),ZE(K0),XS(K0),YS(K0),ZS(K0),NODE(K0)
     1,X(K0),Y(K0),Z(K0)
      DIMENSION WORD(13)
      D1=-L(1)
      D2=-L(2)
      D3=-L(3)
      S=0.0
      F=0.0
      D=20000.0
      DO 555 IGOG=1,K0
      XS(IGOG)=0.0
      YS(IGOG)=0.0
      ZS(IGOG)=0.0
      NHID1(IGOG)=0
      NODE(IGOG)=0
555   CONTINUE
      REWIND 31
      READ(31,20)WORD
20    FORMAT(13A4)
      READ(31,21)IDUM
      IF(IDUM.GT.0)NUMNP=IDUM
      IF(IDUM.GT.0)GO TO 19
21    FORMAT(5X,I5)
      READ(31,21)NUMNP
19    MXNDNM=0
      DIMAX=0.
50    READ(31,21)IPOINT
      IF(IPOINT.GT.MXNDNM)MXNDNM=IPOINT
      IF(IPOINT.EQ.0)GO TO 30
      READ(31,22)AO,BO,CO
22    FORMAT(3E12.5)
      X(IPOINT)=AO
      Y(IPOINT)=BO
      Z(IPOINT)=CO
      IF(AO.GT.DIMAX)DIMAX=AO
      IF(BO.GT.DIMAX)DIMAX=BO
      IF(CO.GT.DIMAX)DIMAX=CO
      NODE(IPOINT)=IPOINT
      GO TO 50
 
 
30    VX=D1*DIMAX*11.
      VY=D2*DIMAX*11.
      VZ=D3*DIMAX*11.
 
 
      DO 284 IRR=1,MXNDNM
      IF(NODE(IRR).EQ.0)GO TO 284
      F1=X(IRR)
      F2=Y(IRR)
      F3=Z(IRR)
      CALL EYE(F1,F2,F3,IRR,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
284   CONTINUE
      DO 285 IPOT=1,MXNDNM
      IF(NODE(IPOT).EQ.0)GO TO 285
      VCC(1)=X(IPOT)
      VCC(2)=Y(IPOT)
      VCC(3)=Z(IPOT)
      CALL SCNCD(VCC,EX0,VY0)
      XS(IPOT)=(EX0-XBB)*SCC+400.
      YS(IPOT)=(VY0-YBB)*SCC+400.
      ZS(IPOT)=(F*(ZE(IPOT)-D))/(ZE(IPOT)*(F-D))
285   CONTINUE
 
      REWIND 11
      READ(31,21)NUMEL
      NEL=0
35    READ(31,21)MTYP
      IF(MTYP.EQ.0)GO TO 100
      IF(MTYP.EQ.10)MTYP=5
      IF(MTYP.EQ.11.OR.MTYP.EQ.12.OR.MTYP.EQ.13)MTYP=4
      READ(31,24)ILN,(ID(J),J=1,8)
      IF(IRANG.NE.1)GO TO 210
      CALL SEELM1(ILN,IKOB)
      IF(IKOB.NE.1)GO TO 35
210   CONTINUE
24    FORMAT(5X,15(I5))
 
 
      GO TO (1,2,3,4,5,6,7,8,9),MTYP
1     GO TO 35
2     GO TO 35
3     NEL=NEL+1
      IF(ID(4).EQ.0)WRITE(11)NEL,ID(1),ID(2),ID(3),ID(3)
      IF(ID(4).NE.0)WRITE(11)NEL,(ID(K),K=1,4)
      GO TO 35
4     GO TO 3
5     IF(ID(7).EQ.0)GO TO 61
      NEL=NEL+1
      WRITE(11)NEL,ID(1),ID(2),ID(6),ID(5)
      NEL=NEL+1
      WRITE(11)NEL,ID(3),ID(4),ID(8),ID(7)
      NEL=NEL+1
      WRITE(11)NEL,ID(2),ID(3),ID(7),ID(6)
      NEL=NEL+1
      WRITE(11)NEL,ID(1),ID(4),ID(8),ID(5)
      NEL=NEL+1
      WRITE(11)NEL,ID(5),ID(6),ID(7),ID(8)
      NEL=NEL+1
      WRITE(11)NEL,(ID(K),K=1,4)
      GO TO 35
61    NEL=NEL+1
      WRITE(11)NEL,ID(1),ID(2),ID(5),ID(4)
      NEL=NEL+1
      WRITE(11)NEL,ID(2),ID(3),ID(6),ID(5)
      NEL=NEL+1
      WRITE(11)NEL,ID(1),ID(3),ID(6),ID(4)
      NEL=NEL+1
      WRITE(11)NEL,ID(1),ID(2),ID(3),ID(3)
      NEL=NEL+1
      WRITE(11)NEL,ID(4),ID(5),ID(6),ID(6)
      GO TO 35
6     GO TO 3
7     GO TO 35
8     GO TO 3
9     GO TO 35
 
 
10    READ(31,32)ILN,(ID(J),J=1,20)
      IF(IRANG.NE.1)GO TO 220
      CALL SEELM1(ILN,IKOB)
      IF(IKOB.NE.1)GO TO 35
220   CONTINUE
32    FORMAT(5X,20(I5))
      TEST=0.
      DO 110 I=9,20
      IF(ID(I).EQ.0)GO TO 110
      ITEST=1
110   CONTINUE
      IF(ITEST.EQ.0)GO TO 5
 
 
      MXNDNM=NUMNP
      IF(ID(9).EQ.0)CALL INTERS(ID(1),ID(2),9,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(10).EQ.0)CALL INTERS(ID(2),ID(3),10,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(11).EQ.0)CALL INTERS(ID(3),ID(4),11,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(12).EQ.0)CALL INTERS(ID(4),ID(1),12,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(13).EQ.0)CALL INTERS(ID(5),ID(6),13,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(14).EQ.0)CALL INTERS(ID(6),ID(7),14,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(15).EQ.0)CALL INTERS(ID(7),ID(8),15,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(16).EQ.0)CALL INTERS(ID(8),ID(5),16,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(17).EQ.0)CALL INTERS(ID(1),ID(5),17,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(18).EQ.0)CALL INTERS(ID(2),ID(6),18,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(19).EQ.0)CALL INTERS(ID(3),ID(7),19,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(20).EQ.0)CALL INTERS(ID(4),ID(8),20,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
 
 
      NO1=ID(9)
      NO2=ID(11)
      NO3=ID(10)
      NO4=ID(12)
      MXNDNM=MXNDNM+1
      CALL IMAGIN(NO1,NO2,NO3,NO4,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      NEL=NEL+1
      WRITE(11)NEL,ID(1),NO1,MXNDNM,NO4
      NEL=NEL+1
      WRITE(11)NEL,ID(2),NO3,MXNDNM,NO1
      NEL=NEL+1
      WRITE(11)NEL,NO3,ID(3),NO2,MXNDNM
      NEL=NEL+1
      WRITE(11)NEL,MXNDNM,NO2,ID(4),NO4
      NO1=ID(11)
      NO2=ID(15)
      NO3=ID(19)
      NO4=ID(20)
      MXNDNM=MXNDNM+1
      CALL IMAGIN(NO1,NO2,NO3,NO4,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      NEL=NEL+1
      WRITE(11)NEL,ID(3),NO3,MXNDNM,NO1
      NEL=NEL+1
      WRITE(11)NEL,NO3,ID(7),NO2,MXNDNM
      NEL=NEL+1
      WRITE(11)NEL,MXNDNM,NO2,ID(8),NO4
      NEL=NEL+1
      WRITE(11)NEL,NO1,MXNDNM,NO4,ID(4)
      NO1=ID(15)
      NO2=ID(13)
      NO3=ID(14)
      NO4=ID(16)
      MXNDNM=MXNDNM+1
      CALL IMAGIN(NO1,NO2,NO3,NO4,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      NEL=NEL+1
      WRITE(11)NEL,ID(7),NO3,MXNDNM,NO1
      NEL=NEL+1
      WRITE(11)NEL,NO1,MXNDNM,NO4,ID(8)
      NEL=NEL+1
      NEL=NEL+1
      WRITE(11)NEL,NO3,ID(6),NO2,MXNDNM
      NEL=NEL+1
      WRITE(11)NEL,MXNDNM,NO2,ID(5),NO4
      NO1=ID(13)
      NO2=ID(9)
      NO3=ID(18)
      NO4=ID(17)
      MXNDNM=MXNDNM+1
      CALL IMAGIN(NO1,NO2,NO3,NO4,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      NEL=NEL+1
      WRITE(11)NEL,ID(6),NO3,MXNDNM,NO1
      NEL=NEL+1
      WRITE(11)NEL,NO1,MXNDNM,NO4,ID(5)
      NEL=NEL+1
      WRITE(11)NEL,NO3,ID(2),NO2,MXNDNM
      NEL=NEL+1
      WRITE(11)NEL,MXNDNM,NO2,ID(1),NO4
      NO1=ID(10)
      NO2=ID(14)
      NO3=ID(18)
      NO4=ID(19)
      MXNDNM=MXNDNM+1
      CALL IMAGIN(NO1,NO2,NO3,NO4,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      NEL=NEL+1
      WRITE(11)NEL,ID(2),NO3,MXNDNM,NO1
      NEL=NEL+1
      WRITE(11)NEL,NO1,MXNDNM,NO4,ID(3)
      NEL=NEL+1
      WRITE(11)NEL,NO3,ID(6),NO2,MXNDNM
      NEL=NEL+1
      WRITE(11)NEL,MXNDNM,NO2,ID(7),NO4
      NO1=ID(12)
      NO2=ID(16)
      NO3=ID(17)
      NO4=ID(20)
      MXNDNM=MXNDNM+1
      CALL IMAGIN(NO1,NO2,NO3,NO4,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      NEL=NEL+1
      WRITE(11)NEL,NO1,ID(1),NO3,MXNDNM,NO1
      NEL=NEL+1
      WRITE(11)NEL,NO1,MXNDNM,NO4,ID(4)
      NEL=NEL+1
      WRITE(11)NEL,NO3,ID(5),NO2,MXNDNM
      NEL=NEL+1
      WRITE(11)NEL,MXNDNM,NO2,ID(8),NO4
      GO TO 35
 
 
11    READ(31,24)ILN,(ID(J),J=1,8)
      IF(IRANG.NE.1)GO TO 230
      CALL SEELM1(ILN,IKOB)
      IF(IKOB.NE.1)GO TO 35
230   CONTINUE
      ITEST=0
      DO 116 I=5,8
      IF(ID(I).EQ.0)GO TO 116
      ITEST=1
116   CONTINUE
      IF(ITEST.EQ.0)GO TO 3
      MXNDNM=NUMNP
      IF(ID(5).EQ.0)CALL INTERS(ID(1),ID(2),5,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(6).EQ.0)CALL INTERS(ID(2),ID(3),6,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(7).EQ.0)CALL INTERS(ID(3),ID(4),7,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      IF(ID(8).EQ.0)CALL INTERS(ID(4),ID(1),8,K0,XE,YE,ZE,XS,YS,ZS,NODE
     1,X,Y,Z)
      NO1=ID(5)
      NO2=ID(7)
      NO3=ID(8)
      NO4=ID(6)
      MXNDNM=MXNDNM+1
      CALL IMAGIN(NO1,NO2,NO3,NO4,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      NEL=NEL+1
      WRITE(11)NEL,ID(1),ID(5),MXNDNM,ID(8)
      NEL=NEL+1
      WRITE(11)NEL,ID(8),MXNDNM,ID(7),ID(4)
      NEL=NEL+1
      WRITE(11)NEL,ID(5),ID(2),ID(6),MXNDNM
      NEL=NEL+1
      WRITE(11)NEL,MXNDNM,ID(6),ID(3),ID(7)
      GO TO 35
 
 
100   CALL SUBHID(K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
200   RETURN
      END
      SUBROUTINE SUBHID(K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      REAL*8 ZSM8,ZSS8
      COMMON/HIDDEN/I123,NH,NHID1(3000)
      COMMON/KAMY/MXNDNM,NUMNP,NEL,VX,VY,VZ,
     $IPOINT,S,F,D,
     $ID(20),RESULT,XKS(4),YKS(4),ZKS(4),ZSS
      DIMENSION IPLNOD(4)
      DIMENSION XK(4),YK(4),ZK(4)
      DIMENSION XE(K0),YE(K0),ZE(K0),XS(K0),YS(K0),ZS(K0),NODE(K0)
     1,X(K0),Y(K0),Z(K0)
      ERROR=0.0001
      NH=0
      REWIND 11
      DO 4 J=1,NEL
      READ(11)IPLANE,(IPLNOD(JJ),JJ=1,4)
      DO 3 M=1,NUMNP
      IF(NODE(M).LE.0)GO TO 3
      DO 5 K=1,4
      IF(NODE(M).EQ.IPLNOD(K))GO TO 3
      LL=IPLNOD(K)
      XK(K)=XS(LL)
      XKS(K)=XS(LL)
      YK(K)=YS(LL)
      YKS(K)=YS(LL)
      ZK(K)=ZS(LL)
      ZKS(K)=ZS(LL)
5     CONTINUE
      IF(ABS(XK(1)-XK(2)).LT.ERROR.AND.ABS(XK(2)-XK(3)).LT.ERROR.
     $AND.ABS(XK(3)-XK(4)).LT.ERROR)GO TO 4
      IF(ABS(YK(1)-YK(2)).LT.ERROR.AND.ABS(YK(2)-YK(3)).LT.ERROR.
     $AND.ABS(YK(3)-YK(4)).LT.ERROR)GO TO 4
      IF(ABS(XS(M)-XK(1)).LT.ERROR.AND.ABS(YS(M)-YK(1)).LT.
     $ERROR)GO TO 19
      IF(ABS(XS(M)-XK(2)).LT.ERROR.AND.ABS(YS(M)-YK(2)).LT.
     $ERROR)GO TO 19
      IF(ABS(XS(M)-XK(3)).LT.ERROR.AND.ABS(YS(M)-YK(3)).LT.
     $ERROR)GO TO 19
      IF(ABS(XS(M)-XK(4)).LT.ERROR.AND.ABS(YS(M)-YK(4)).LT.
     $ERROR)GO TO 19
      XMIN=XK(1)
      YMIN=YK(1)
      XMAX=XK(1)
      YMAX=YK(1)
      DO 7 MN=2,4
      IF(XK(MN).LT.XMIN)XMIN=XK(MN)
      IF(XK(MN).GT.XMAX)XMAX=XK(MN)
      IF(YK(MN).LT.YMIN)YMIN=YK(MN)
      IF(YK(MN).GT.YMAX)YMAX=YK(MN)
7     CONTINUE
      IF(ABS(XS(M)).LT.ABS(XMIN).OR.ABS(XS(M)).GT.ABS(XMAX))GO TO 3
      IF(ABS(YS(M)).LT.ABS(YMIN).OR.ABS(YS(M)).GT.ABS(YMAX))GO TO 3
      CALL FINAL(XS(M),YS(M),K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      IF(RESULT.EQ.1.0)GO TO 3
19    CALL DEPTH(XS(M),YS(M),K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      ZSM8=ZS(M)
      ZSS8=ZSS
      IF(ZSM8.LT.ZSS8)GO TO 3
      IF(DABS(ZSM8-ZSS8).LE.0.000001D0)GO TO 3
20    NH=NH+1
      NHID1(NH)=M
      NODE(M)=-M
3     CONTINUE
4     CONTINUE
      RETURN
      END
      SUBROUTINE EYE(XOO,YOO,ZOO,IPOT,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      COMMON/KAMY/MXNDNM,NUMNP,NEL,VX,VY,VZ,
     $IPOINT,S,F,D,
     $ID(20),RESULT,XKS(4),YKS(4),ZKS(4),ZSS
      DIMENSION XE(K0),YE(K0),ZE(K0),XS(K0),YS(K0),ZS(K0),NODE(K0)
     1,X(K0),Y(K0),Z(K0)
      X1=XOO-VX
      Y1=YOO-VY
      Z1=ZOO-VZ
      PI=4.*ATAN(1.)
      ROT=90.*PI/180.
      X2=X1
      Y2=Y1*COS(ROT)+Z1*SIN(ROT)
      Z2=-Y1*SIN(ROT)+Z1*COS(ROT)
      IF(VX.EQ.0..AND.VY.EQ.0.)GO TO 43
      TETA1=PI+ACOS(VY/(SQRT(VX**2+VY**2)))
      GO TO 45
43    TETA1=PI
45    X3=X2*COS(-TETA1)-Z2*SIN(-TETA1)
      Y3=Y2
      Z3=X2*SIN(-TETA1)+Z2*COS(-TETA1)
      TETA2=ACOS(SQRT(VX**2+VY**2)/SQRT(VX**2+VY**2+VZ**2))
      X4=X3
      Y4=Y3*COS(-TETA2)+Z3*SIN(-TETA2)
      Z4=-Y3*SIN(-TETA2)+Z3*COS(-TETA2)
      XE(IPOT)=X4
      YE(IPOT)=Y4
      ZE(IPOT)=-Z4
      IF(ABS(XE(IPOT)).GT.S)S=XE(IPOT)
      IF(ABS(YE(IPOT)).GT.S)S=YE(IPOT)
      IF(ABS(ZE(IPOT)).GT.F)F=ZE(IPOT)
      RETURN
      END
      SUBROUTINE DEPTH(SX,SY,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      REAL*8 ONE,TWO,THREE,FOUR,FIVE
      COMMON/KAMY/MXNDNM,NUMNP,NEL,VX,VY,VZ,
     $IPOINT,S,F,D,
     $ID(20),RESULT,XKS(4),YKS(4),ZKS(4),ZSS
      ONE=XKS(1)*YKS(2)-XKS(2)*YKS(1)
      TWO=XKS(1)*ZKS(2)-XKS(2)*ZKS(1)
      THREE=XKS(1)-XKS(2)
      FOUR=XKS(1)*YKS(3)-XKS(3)*YKS(1)
      FIVE=XKS(1)*ZKS(3)-XKS(3)*ZKS(1)
      SIX=XKS(1)-XKS(3)
      IF((TWO*FOUR-FIVE*ONE).EQ.0.)GO TO 10
      CC=(ONE*SIX-FOUR*THREE)/(TWO*FOUR-FIVE*ONE)
      IF(ONE.EQ.0.)GO TO 10
      BB=-(THREE+CC*TWO)/ONE
      IF(XKS(1).EQ.0.)GO TO 10
      AA=-(BB*YKS(1)+CC*ZKS(1)+1.)/XKS(1)
      IF(CC.EQ.0.)GO TO 10
      ZSS=-(1.+AA*SX+BB*SY)/CC
      GO TO 20
10    ZSS=100.
20    RETURN
      END
      SUBROUTINE FINAL(CPX,CPY,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      COMMON/KAMY/MXNDNM,NUMNP,NEL,VX,VY,VZ,
     $IPOINT,S,F,D,
     $ID(20),RESULT,XKS(4),YKS(4),ZKS(4),ZSS
      DIMENSION GOY(4)
      NI=0
      ERROR=0.0001
      DO 100 II=1,4
      IP=II+1
      IF(II.EQ.4)IP=1
      IF(XKS(IP).EQ.XKS(II))GO TO 100
      SMALLX=XKS(II)
      IF(XKS(IP).LT.SMALLX)GO TO 150
      BIGX=XKS(IP)
      GO TO 200
150   SMALLX=XKS(IP)
      BIGX=XKS(II)
200   IF(CPX.LT.SMALLX.OR.CPX.GT.BIGX)GO TO 100
      YINT=(((CPX-XKS(II))*(YKS(IP)-YKS(II)))/
     1(XKS(IP)-XKS(II)))+YKS(II)
      NI=NI+1
      GOY(NI)=YINT
100   CONTINUE
      YLARGE=GOY(1)
      YSMALL=GOY(1)
      DO 300 NOK=2,NI
      IF(GOY(NOK).LT.YSMALL)YSMALL=GOY(NOK)
      IF(GOY(NOK).GT.YLARGE)YLARGE=GOY(NOK)
300   CONTINUE
      RESULT=0.0
      IF(CPY.LT.YSMALL.OR.CPY.GT.YLARGE)RESULT=1.0
      RETURN
400   RESULT=0.0
      RETURN
      END
      SUBROUTINE IMAGIN(NO1,NO2,NO3,NO4,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      COMMON/KAMY/MXNDNM,NUMNP,NEL,VX,VY,VZ,
     $IPOINT,S,F,D,
     $ID(20),RESULT,XKS(4),YKS(4),ZKS(4),ZSS
      DIMENSION XE(K0),YE(K0),ZE(K0),XS(K0),YS(K0),ZS(K0),NODE(K0)
     1,X(K0),Y(K0),Z(K0)
      A=X(NO2)-X(NO1)
      B=Y(NO2)-Y(NO1)
      C=X(NO4)-X(NO3)
      D=Y(NO4)-Y(NO3)
      E=Z(NO2)-Z(NO1)
      X(MXNDNM)=(D*X(NO3)-C*Y(NO3)-(B*C*X(NO1))/A+C*Y(NO1))/(D-C*B/A)
      WX=X(MXNDNM)
      Y(MXNDNM)=(MX*B-B*X(NO1)+A*Y(NO1))/A
      WY=Y(MXNDNM)
      Z(MXNDNM)=((MY-Y(NO1))*E+B*Z(NO1))/B
      WZ=Z(MXNDNM)
      CALL EYE(WX,WY,WZ,MXNDNM,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      RETURN
      END
      SUBROUTINE INTERS(ME1,ME2,KK,K0,XE,YE,ZE,XS,YS,ZS,NODE,X,Y,Z)
      COMMON/KAMY/MXNDNM,NUMNP,NEL,VX,VY,VZ,
     $IPOINT,S,F,D,
     $ID(20),RESULT,XKS(4),YKS(4),ZKS(4),ZSS
      DIMENSION XE(K0),YE(K0),ZE(K0),XS(K0),YS(K0),ZS(K0),NODE(K0)
     1,X(K0),Y(K0),Z(K0)
      MXNDNM=MXNDNM+1
      ID(KK)=MXNDNM
      X(MXNDNM)=(X(ME1)+X(ME2))/2.
      Y(MXNDNM)=(Y(ME1)+Y(ME2))/2.
      Z(MXNDNM)=(Z(ME1)+Z(ME2))/2.
      RETURN
      END
      FUNCTION DECIMA(ERROR)
      LOGICAL LEXP,AFTER,MINUS,ERROR
      DOUBLE PRECISION MANT,DECIMA
      INTEGER EXP
      COMMON/FRECNM/MULTIP
      LEXP    = .FALSE.
      MINUS   = .FALSE.
      AFTER   = .FALSE.
      IOFF    = 1
      MANT    = 0.0
      EXP     = 0
      X       = 0.0
      DO 100  IPOSIT=1,20
      N = IDIGFG(IPOSIT)
      GO TO (5,5,5,5,5,5,5,5,5,5,100,12,13,14,14,16,17,18),N
5     IF (AFTER) GO TO 6
      X = X*10.0 + N - 1.0
      GO TO 100
6     Y = N - 1
      X = X + Y/10.0**IOFF
      IOFF = IOFF + 1
      GO TO 100
12    MINUS = .TRUE.
      GO TO 100
13    AFTER = .TRUE.
      IOFF = 1
      GO TO 100
14    MANT = X
      IF (MINUS) MANT = -X
      MINUS = .FALSE.
      AFTER = .FALSE.
      LEXP  = .TRUE.
      X     = 0.0
      GO TO 100
17    MULTIP=X
      GO TO 100
100   CONTINUE
18    ERROR = .TRUE.
16    IF (LEXP) EXP = X
      IF (LEXP.AND.MINUS) EXP = -X
      IF (.NOT.LEXP) MANT = X
      IF (.NOT.LEXP.AND.MINUS) MANT = -X
      DECIMA = MANT*10.0**EXP
      RETURN
      END
      FUNCTION ERR1(ERR001)
      INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW
      LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD,IGET,RGET,ERR1
      COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,
     1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,
     2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT
      ERR1=ERROR
      RETURN
      END
      SUBROUTINE GETNL(GET001)
      INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW
      LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD,IGET,RGET,ERR1
      COMMON/UNIT/II1,II2,II3,II4,II5,ITER
      COMMON/FRECNM/MULTIP
      COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,
     1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,
     2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT
      DATA    IZER/1H0/,ININE/1H9/,ICOM/1H*/,IDOL/1H$/
      MULTIP=0
      IF (.NOT.ERROR) GO TO 100
9800  WRITE (*,9801)
9801  FORMAT (' SYNTAX ERROR , INPUT AGAIN')
      WRITE(*,101)LINE
      ERROR = .FALSE.
      EPOINT = 1
100   READ (*,101,ERR=9800,END=910) (LINE(JJ),JJ=1,71)
101   FORMAT (71A1)
      LINENM = LINENM + 1
210   CONTINUE
      POINT = 1
      EOL   = .FALSE.
      EOS   = .FALSE.
      RETURN
910   EOF = .TRUE.
      RETURN
      END
      FUNCTION GETWRD(GET001)
      INTEGER SECT,POINT,BEGIN,GETSEC,EPOINT,BLANK,AGET,AGETW
      LOGICAL EOL,EOS,EOF,ERROR,INDEX,GETWRD,IGET,RGET,ERR1
      COMMON  /FRECNT/ LINE(80),SECT,EOL,EOS,EOF,
     1ERROR,BLANK,ICOMMA,POINT,BEGIN,LENGTH,
     2EPOINT,NSECT,LINENM,MAXSTR,KUNIT,JUNIT,IUNIT
      GETWRD = .FALSE.
      LENGTH = 0
      IF (EOL) RETURN
      DO 100 BEGIN = POINT,80
      IF (LINE(BEGIN).NE.BLANK) GO TO 110
100   CONTINUE
      EOL = .TRUE.
      POINT = 80
      RETURN
110   DO 170 POINT = BEGIN,80
      IF (LINE(POINT).EQ.BLANK.OR.LINE(POINT).EQ.ICOMMA)
     1GO TO 180
      LENGTH = POINT - BEGIN + 1
      MAXSTR = LENGTH
170   CONTINUE
      GETWRD = .TRUE.
      EOL = .TRUE.
      RETURN
180   IP = POINT
      DO 200 POINT = POINT,80
      IF (LINE(POINT).EQ.ICOMMA) GO TO 210
      IF (LINE(POINT).NE.BLANK) GO TO 190
200   CONTINUE
      GETWRD = .TRUE.
      EOL =.TRUE.
      RETURN
190   POINT = IP
      GETWRD = .TRUE.
      RETURN
210   POINT = POINT + 1
      GETWRD = .TRUE.
      RETURN
      END
      FUNCTION IDIGFG(IPOSIT)
      INTEGER AGET
      DIMENSION IVALID(17)
      DATA IVALID/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,1H+,
     11H-,1H.,1HE,1HD,1H ,1H*/
      DO 100 IDIGFG=1,17
      IF (AGET(IPOSIT).EQ.IVALID(IDIGFG)) GO TO 110
100   CONTINUE
      IDIGFG = 18
110   RETURN
      END
      SUBROUTINE INITM(NGPT,NELT,X,Y,Z)
      REAL*8 FNM
      COMMON/HP21/IHP21,PAT21,HI21
      COMMON/HIDDEN/IHIDE
      COMMON/MSTREE/S100,S101,KALOR,NCOL
      COMMON/SENOD1/ISEND
      COMMON/SHLOAD/LOAD6
      COMMON/IGL100/IGLKEY,IBAUD,IDEV,IOPT,PXSIZE,PYSIZE
      COMMON/TEKPLT/KEYTEK
      COMMON/RAMTEK/MTEK1
      COMMON/VS11VA/IVS11,IMOVE
      COMMON/CALCOM/ICAL
      COMMON/SHRINK/ISHR1
      COMMON/SHOWAX/ISHOW1
      COMMON/GROUP/IGR1
      DIMENSION X(NGPT),Y(NGPT),Z(NGPT)
      DIMENSION FN(15),LN(2,15)
      COMMON /MES/L(10),V(10),I,IS,IERR
      COMMON /PLT/IPN,IEN,ILN,XB,YB,SC,SCL,SCD,SCFL,SCFD,ISR,INR,LABL
     1,TYPEU,TYPED,WHAT,LNTYPD,LNTYPU,SCALE,IBCS,IPOINT,ILOAD
      COMMON /BX/BM(3),BL(6),BLS(6)
      COMMON/ROTAT/IROT
      COMMON/WATYPE/KSTYPE
      COMMON/STRESS/IFLOK,IST1
      COMMON/IWINDO/IWIND,XM1,XM2,YM1,YM2,WINLEN
      COMMON/ELRANG/IRANG
      COMMON /ANG/H,SX,SY,CX,CY,IDC(3)
      COMMON /PT/NU,NS,VC(3)
      COMMON/LAB/ILAB
      EQUIVALENCE (LM,FN),(LS,LN),(XJOB,FNM)
      DATA BLNK/1H /,UUUU/1HU/,SSSS/1HS/
      IF(I.EQ.8)GO TO 31
10    I300=30
      CALL INITT(I300)
20    DO 11 I=1,5,2
      BLS(I)=1.E20
11    BLS(I+1)=-1.E20
      DO 21 I=1,NGPT
      VC(1)=X(I)
      VC(2)=Y(I)
      VC(3)=Z(I)
      DO 21 J=1,3
      J2=2*J
      IF (VC(J) .LT. BLS(J2-1)) BLS(J2-1)=VC(J)
      IF (VC(J) .GT. BLS(J2)) BLS(J2)=VC(J)
21    CONTINUE
31    LABL=-1
      WHAT=UUUU
      TYPEU=SSSS
      LNTYPD=3434
      LNTYPU=0
      ILN=1
      IWIND=-1
      XM1=0.0
      XM2=800.0
      YM1=0.0
      YM2=800.0
      WINLEN=800.
      IHP21=-1
      IHIDE=-1
      NCOL=7
      MTEK1=-1
      IGLKEY=0
      IMOVE=-1
      ISHOW1=-1
      ICAL=-1
      ISHR1=-1
      ISEND=-1
      LOAD6=-1
      IROT=-1
      KSTYPE=-1
      IGR1=-1
      PAT21=10.0
      IRANG=-1
      HI21=12.0
      ILOAD=-1
      IBCS=-1
      IPOINT=-1
      IPN=-1
      IEN=-1
      IST1=-1
      H=1.E20
      SX=0.
      SY=0.
      CX=1.
      CY=1.
      IDC(1)=0
      IDC(2)=0
      IDC(3)=1
      DO 41 I=1,6
41    BL(I)=BLS(I)
      DO 51 I=1,3
51    BM(I)=.5*(BL(2*I)+BL(2*I-1))
      RETURN
      END
