95
96
97
98#include "implicit_f.inc"
99#include "com01_c.inc"
100
101
102
103 INTEGER IRECT(4,*), NSV(*),IRTL(*),
104 . IPARI(*),MSEGTYP2(*),IRUPT(*)
106 . x(3,*),crst(2,*),stifn(*),stifr(*), ms(*),csts_bis(2,*),in(*)
107
108
109
110 INTEGER II,I,J,JJ,L,IX1,IX2,IX3,IX4,NIR,NRTM,NSN,NMN,K
112 . bid,bid4(4),bid9(9),x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,xs(3),xm(3),x0,y0,z0,betax,betay,betaz,
113 . e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,h(4),h2(4),ss,st,sp,sm,tp,tm,rs(3),rm(3),rx(4),ry(4),rz(4),
114 . fac_triang,stbrk,dwdu,stifmr,stifm,ins,stf,aa
115
116 nrtm = ipari(4)
117 nsn = ipari(5)
118 nmn = ipari(6)
119
120 bid = zero
121 bid4(1:4)=zero
122 bid9(1:9)=zero
123
124 DO ii=1,nsn
125 IF (irupt(ii) /= 0) cycle
126 i = nsv(ii)
127 l = irtl(ii)
128
129 ix1 = irect(1,l)
130 ix2 = irect(2,l)
131 ix3 = irect(3,l)
132 ix4 = irect(4,l)
133
134 IF (ix3 == ix4) THEN
135
136 nir = 3
137 h(1) = crst(1,ii)
138 h(2) = crst(2,ii)
139 h(3) = one-crst(1,ii)-crst(2,ii)
140 h(4) = zero
141 h2(1) = csts_bis(1,ii)
142 h2(2) = csts_bis(2,ii)
143 h2(3) = one-csts_bis(1,ii)-csts_bis(2,ii)
144 h2(4) = zero
145 ELSE
146
147 nir = 4
148 ss=crst(1,ii)
149 st=crst(2,ii)
150 sp=one + ss
151 sm=one - ss
152 tp=fourth*(one + st)
153 tm=fourth*(one - st)
154 h(1)=tm*sm
155 h(2)=tm*sp
156 h(3)=tp*sp
157 h(4)=tp*sm
158
159
160 ss=csts_bis(1,ii)
161 st=csts_bis(2,ii)
162 sp=one + ss
163 sm=one - ss
164 tp=fourth*(one + st)
165 tm=fourth*(one - st)
166 h2(1)=tm*sm
167 h2(2)=tm*sp
168 h2(3)=tp*sp
169 h2(4)=tp*sm
170 ENDIF
171
172 IF (msegtyp2(l)==0) THEN
173
174
175 x1 = x(1,ix1)
176 y1 = x(2,ix1)
177 z1 = x(3,ix1)
178 x2 = x(1,ix2)
179 y2 = x(2,ix2)
180 z2 = x(3,ix2)
181 x3 = x(1,ix3)
182 y3 = x(2,ix3)
183 z3 = x(3,ix3)
184 x4 = x(1,ix4)
185 y4 = x(2,ix4)
186 z4 = x(3,ix4)
187 xs(1) = x(1,i)
188 xs(2) = x(2,i)
189 xs(3) = x(3,i)
190
191 CALL i2rep(x1 ,x2 ,x3 ,x4 ,
192 . y1 ,y2 ,y3 ,y4 ,
193 . z1 ,z2 ,z3 ,z4 ,
194 . e1x ,e1y ,e1z ,
195 . e2x ,e2y ,e2z ,
196 . e3x ,e3y ,e3z ,nir)
197
198
199 IF (nir == 4) THEN
200 fac_triang = one
201 x0 = fourth*(x1 + x2 + x3 + x4)
202 y0 = fourth*(y1 + y2 + y3 + y4)
203 z0 = fourth*(z1 + z2 + z3 + z4)
204 ELSE
205 fac_triang = zero
206 x0 = third*(x1 + x2 + x3)
207 y0 = third*(y1 + y2 + y3)
208 z0 = third*(z1 + z2 + z3)
209 ENDIF
210
211 xs(1) = xs(1) - x0
212 xs(2) = xs(2) - y0
213 xs(3) = xs(3) - z0
214
215 x1 = x1 - x0
216 y1 = y1 - y0
217 z1 = z1 - z0
218 x2 = x2 - x0
219 y2 = y2 - y0
220 z2 = z2 - z0
221 x3 = x3 - x0
222 y3 = y3 - y0
223 z3 = z3 - z0
224 x4 = x4 - x0
225 y4 = y4 - y0
226 z4 = z4 - z0
227
228 IF (nir==3) THEN
229 x4 = zero
230 y4 = zero
231 z4 = zero
232 END IF
233
234 xm(1) = x1*h(1) + x2*h(2) + x3*h(3) + x4*h(4)
235 xm(2) = y1*h(1) + y2*h(2) + y3*h(3) + y4*h(4)
236 xm(3) = z1*h(1) + z2*h(2) + z3*h(3) + z4*h(4)
237
238
239
240 rs(1) = xs(1)*e1x + xs(2)*e1y + xs(3)*e1z
241 rs(2) = xs(1)*e2x + xs(2)*e2y + xs(3)*e2z
242 rs(3) = xs(1)*e3x + xs(2)*e3y + xs(3)*e3z
243
244 rm(1) = xm(1)*e1x + xm(2)*e1y + xm(3)*e1z
245 rm(2) = xm(1)*e2x + xm(2)*e2y + xm(3)*e2z
246 rm(3) = xm(1)*e3x + xm(2)*e3y + xm(3)*e3z
247
248 rx(1) = e1x*x1 + e1y*y1 + e1z*z1
249 ry(1) = e2x*x1 + e2y*y1 + e2z*z1
250 rz(1) = e3x*x1 + e3y*y1 + e3z*z1
251 rx(2) = e1x*x2 + e1y*y2 + e1z*z2
252 ry(2) = e2x*x2 + e2y*y2 + e2z*z2
253 rz(2) = e3x*x2 + e3y*y2 + e3z*z2
254 rx(3) = e1x*x3 + e1y*y3 + e1z*z3
255 ry(3) = e2x*x3 + e2y*y3 + e2z*z3
256 rz(3) = e3x*x3 + e3y*y3 + e3z*z3
257 rx(4) = e1x*x4 + e1y*y4 + e1z*z4
258 ry(4) = e2x*x4 + e2y*y4 + e2z*z4
259 rz(4) = e3x*x4 + e3y*y4 + e3z*z4
260
261
262 CALL i2cin_rot27(stbrk,rs,rm,rx(1),ry(1),rz(1),rx(2),ry(2),rz(2),rx(3),ry(3),rz(3),
263 . rx(4),ry(4),rz(4),bid9,dwdu,e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,
264 . nir,betax,betay)
265
266
267 IF (iroddl==1) THEN
268
270 . bid4 ,bid4 ,bid4 ,h ,stifm ,
271 . bid4 ,bid4 ,bid4 ,stifmr ,betax ,
272 . betay)
273 ELSE
274
276 . bid4 ,bid4 ,bid4 ,h ,stifm ,
277 . bid4 ,bid4 ,bid4 ,stifmr ,betax ,
278 . betay)
279 stifmr = zero
280 ENDIF
281
282 ELSE
283 stifm=zero
284 stbrk=zero
285 stifmr=zero
286 dwdu=zero
287 ENDIF
288
289 IF ((iroddl/=0).AND.(msegtyp2(l)==0)) THEN
290
291 aa =(xm(1)-xs(1))*(xm(1)-xs(1))+(xm(2)-xs(2))*(xm(2)-xs(2))+(xm(3)-xs(3))*(xm(3)-xs(3))
292 ins = in(i) + aa * ms(i)
293 stf = stifr(i) + aa * stifn(i)
294
295 DO jj=1,nir
296 j=irect(jj,l)
297 ms(j)=ms(j)+ms(i)*h2(jj)
298 stifn(j)=stifn(j)+stifn(i)*(one+stbrk)*(abs(h(jj))+stifm)+stifr(i)*stifmr*dwdu
299 in(j)=in(j)+ins*h2(jj)
300 stifr(j)=stifr(j)+abs(stf*h(jj))
301 ENDDO
302
303 stifn(i) = zero
304 stifr(i) = zero
305 ms(i) = zero
306 in(i) = zero
307
308 ELSE
309 DO jj=1,nir
310 j=irect(jj,l)
311 ms(j)=ms(j)+ms(i)*h2(jj)
312 stifn(j)=stifn(j)+stifn(i)*(one+stbrk)*(abs(h(jj))+stifm)
313 ENDDO
314
315 stifn(i)=zero
316 ms(i)=zero
317
318 END IF
319
320 ENDDO
321
322
323 RETURN
subroutine i2cin_rot27(stbrk, rs, rm, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, dpara, dwdu, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, nir, betax, betay)
subroutine i2loceq_27(nir, rs, rx, ry, rz, fmx, fmy, fmz, h, stifm, mxs, mys, mzs, stifmr, betax, betay)
subroutine i2rep(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, nir)