38
39
40
42 USE elbufdef_mod
43
44
45
46#include "implicit_f.inc"
47
48
49
50#include "vect01_c.inc"
51#include "com01_c.inc"
52#include "sphcom.inc"
53#include "param_c.inc"
54
55
56
57 INTEGER KXSP(NISP,*),IXSP(KVOISPH,*),NOD2SP(*),ITAB(*),
58 . ISPCOND(NISPCOND,*), ISORTSP, IPARG(NPARG,*),
59 . WSP2SORT(*), NP2SORTF, NP2SORTL
60
62 . x(3,*), v(3,*), ms(*), spbuf(nspbuf,*),xframe(nxframe,*)
63 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION (NGROUP) :: ELBUF_TAB
64
65
66
67 INTEGER K,N,INOD,JS,
68 . IS,IC,NC,ISLIDE,ILEV,
69 . NG,NEL,I,II(6),NS,
71 . xi,yi,zi,
72 . vxi,vyi,vzi,
73 . ox,oy,oz,ux,uy,uz,vx,vy,vz,wx,wy,wz,
74 . xs,ys,zs,vxs,vys,vzs,vn,dd,di,
75 . txx,txy,txz,tyy,tyz,tzz,
76 . uxx,uxy,uxz,uyx,uyy,uyz,uzx,uzy,uzz,
77 . vxx,vxy,vxz,vyy,vyz,vzz
78 TYPE(G_BUFEL_) ,POINTER :: GBUF
79
80 vx = zero
81 vy = zero
82 vz = zero
83 DO nc=1,nspcond
84 ilev=ispcond(1,nc)
85 IF(ilev==1)THEN
86 is =ispcond(3,nc)
87 ic =ispcond(2,nc)
88 islide=ispcond(5,nc)
89 ox=xframe(10,is)
90 oy=xframe(11,is)
91 oz=xframe(12,is)
92 ux=xframe(3*(ic-1)+1,is)
93 uy=xframe(3*(ic-1)+2,is)
94 uz=xframe(3*(ic-1)+3,is)
95 IF(islide==1)THEN
96 IF (ic==1) THEN
97 vx=xframe(4,is)
98 vy=xframe(5,is)
99 vz=xframe(6,is)
100 wx=xframe(7,is)
101 wy=xframe(8,is)
102 wz=xframe(9,is)
103 ELSEIF (ic==2) THEN
104 vx=xframe(7,is)
105 vy=xframe(8,is)
106 vz=xframe(9,is)
107 wx=xframe(1,is)
108 wy=xframe(2,is)
109 wz=xframe(3,is)
110 ELSEIF (ic==3) THEN
111 vx=xframe(1,is)
112 vy=xframe(2,is)
113 vz=xframe(3,is)
114 wx=xframe(4,is)
115 wy=xframe(5,is)
116 wz=xframe(6,is)
117 ENDIF
118 ENDIF
119 DO ns =np2sortf,np2sortl
120 n=wsp2sort(ns)
121 inod=kxsp(3,n)
122 xi =x(1,inod)
123 yi =x(2,inod)
124 zi =x(3,inod)
125 vxi=v(1,inod)
126 vyi=v(2,inod)
127 vzi=v(3,inod)
128 di =spbuf(1,n)
129 dd=(xi-ox)*ux+(yi-oy)*uy+(zi-oz)*uz
130 IF(dd<-em20*di)THEN
131
132
133 xs=xi-two*dd*ux
134 ys=yi-two*dd*uy
135 zs=zi-two*dd*uz
136 IF(islide==0)THEN
137 vxs=-vxi
138 vys=-vyi
139 vzs=-vzi
140 ELSE
141 vn=vxi*ux+vyi*uy+vzi*uz
142 vxs=vxi-two*vn*ux
143 vys=vyi-two*vn*uy
144 vzs=vzi-two*vn*uz
145 ENDIF
146 x(1,inod)=xs
147 x(2,inod)=ys
148 x(3,inod)=zs
149 v(1,inod)=vxs
150 v(2,inod)=vys
151 v(3,inod)=vzs
152
153
154
155
156
157
158 IF(islide==1)THEN
159
160
161 ng=mod(kxsp(2,n),ngroup+1)
162 IF(ng>0)THEN
164 2 mtn ,nel ,nft ,iad ,ity ,
165 3 npt ,jale ,ismstr ,jeul ,jtur ,
166 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
167 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
168 6 irep ,iint ,igtyp ,israt ,isrot ,
169 7 icsen ,isorth ,isorthg ,ifailure,jsms )
170 gbuf => elbuf_tab(ng)%GBUF
171 DO j=1,6
172 ii(j) = nel*(j-1)
173 ENDDO
174
175 i = n-nft
176 txx= gbuf%SIG(ii(1)+i)
177 tyy= gbuf%SIG(ii(2)+i)
178 tzz= gbuf%SIG(ii(3)+i)
179 txy= gbuf%SIG(ii(4)+i)
180 tyz= gbuf%SIG(ii(5)+i)
181 txz= gbuf%SIG(ii(6)+i)
182
183
184 uxx=txx*ux+txy*uy+txz*uz
185 uxy=txx*vx+txy*vy+txz*vz
186 uxz=txx*wx+txy*wy+txz*wz
187 uyx=txy*ux+tyy*uy+tyz*uz
188 uyy=txy*vx+tyy*vy+tyz*vz
189 uyz=txy*wx+tyy*wy+tyz*wz
190 uzx=txz*ux+tyz*uy+tzz*uz
191 uzy=txz*vx+tyz*vy+tzz*vz
192 uzz=txz*wx+tyz*wy+tzz*wz
193 vxx=ux*uxx+uy*uyx+uz*uzx
194 vxy=ux*uxy+uy*uyy+uz*uzy
195 vxz=ux*uxz+uy*uyz+uz*uzz
196 vyy=vx*uxy+vy*uyy+vz*uzy
197 vyz=vx*uxz+vy*uyz+vz*uzz
198 vzz=wx*uxz+wy*uyz+wz*uzz
199
200
201 vxy=-vxy
202 vxz=-vxz
203
204
205 uxx=vxx*ux+vxy*vx+vxz*wx
206 uxy=vxx*uy+vxy*vy+vxz*wy
207 uxz=vxx*uz+vxy*vz+vxz*wz
208 uyx=vxy*ux+vyy*vx+vyz*wx
209 uyy=vxy*uy+vyy*vy+vyz*wy
210 uyz=vxy*uz+vyy*vz+vyz*wz
211 uzx=vxz*ux+vyz*vx+vzz*wx
212 uzy=vxz*uy+vyz*vy+vzz*wy
213 uzz=vxz*uz+vyz*vz+vzz*wz
214 txx=ux*uxx+vx*uyx+wx*uzx
215 txy=ux*uxy+vx*uyy+wx*uzy
216 txz=ux*uxz+vx*uyz+wx*uzz
217 tyy=uy*uxy+vy*uyy+wy*uzy
218 tyz=uy*uxz+vy*uyz+wy*uzz
219 tzz=uz*uxz+vz*uyz+wz*uzz
220
221 gbuf%SIG(ii(1)+i) = txx
222 gbuf%SIG(ii(2)+i) = tyy
223 gbuf%SIG(ii(3)+i) = tzz
224 gbuf%SIG(ii(4)+i) = txy
225 gbuf%SIG(ii(5)+i) = tyz
226 gbuf%SIG(ii(6)+i) = txz
227 ENDIF
228 ENDIF
229 ENDIF
230 ENDDO
231 ENDIF
232 ENDDO
233
234 RETURN
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)