42
43
44
46
47
48
49#include "implicit_f.inc"
50
51
52
53 INTEGER NSN, NMN, I0,I2SIZE,IDEL2
54 INTEGER IRECT(4,*),NSV(*),MSR(*),IRTL(*),WEIGHT(*),IADI2(4,*)
55
57 . ms(*),in(*),mmass(*),smass(*),siner(*),x(3,*),v(3,*),vr(3,*),
58 . a(3,*),ar(3,*),stifn(*),stifr(*),fsav(*),crst(2,*),
59 . fskyi2(i2size,*),fncont(3,*),fncontp(3,*),ftcontp(3,*)
60 TYPE (H3D_DATABASE) :: H3D_DATA
61
62
63
64 INTEGER I1,I2,I3,I4,II,IS,IM,JJ,L,NN,NIR
65 INTEGER INOD(4)
67 . xms,ins,stfn,stfr,fs(3),moms(3),ls1,ls2,lt1,lt2,
68 . ls,lt,len,s,t,xc,yc,zc,dm1,dm2,din1,din2,din3,
69 . sumhrs,sumhrt,sumhprs,sumhprt
71 . fsloc(6),fmloc(4,6),rot(9),roti(9),dm(4),din(4),dstfn(4),
72 . dstfr(4),h(4),hh(4),hrs(4),hrt(4),hps(4),hpt(4),hprs(4),
73 . hprt(4),hxs(4),hxt(4),fx(4),fy(4),fz(4)
74
75 nir = 4
76
77#include "vectorize.inc"
78 DO ii=1,nmn
79 im=msr(ii)
80 mmass(ii)=ms(im)
81 in(im)=
max(em20,in(im))
82 ENDDO
83
84 DO ii=1,nsn
85 is = nsv(ii)
86 IF (is > 0) THEN
87 IF (weight(is) == 1) THEN
88 l = irtl(ii)
89 DO jj=1,nir
90 inod(jj) = irect(jj,l)
91 ENDDO
92
94 . lt1 ,lt2 ,rot(1) ,rot(4) ,rot(7) ,
95 . rot(2) ,rot(5) ,rot(8) ,rot(3) ,rot(6) ,
96 . rot(9) )
98
99 s=crst(1,ii)
100 t=crst(2,ii)
102 . nir,s,t,h,hh,hrs,hrt,hps,hpt,hprs,hprt,
103 . hxs,hxt,ls1,ls2,lt1,lt2,ls,lt)
104
105 sumhrs = abs(hrs(1) +hrs(2) +hrs(3) +hrs(4))
106 sumhrt = abs(hrt(1) +hrt(2) +hrt(3) +hrt(4))
107 sumhprs = abs(hprs(1)+hprs(2)+hprs(3)+hprs(4))
108 sumhprt = abs(hprt(1)+hprt(2)+hprt(3)+hprt(4))
109 i1 = inod(1)
110 i2 = inod(2)
111 i3 = inod(3)
112 i4 = inod(4)
113 xc = x(1,i1)*h(1)+x(1,i2)*h(2)+x(1,i3)*h(3)+x(1,i4)*h(4)
114 yc = x(2,i2)*h(1)+x(2,i2)*h(2)+x(2,i3)*h(3)+x(2,i4)*h(4)
115 zc = x(3,i3)*h(1)+x(3,i2)*h(2)+x(3,i3)*h(3)+x(3,i4)*h(4)
116
117 fs(1) = a(1,is)
118 fs(2) = a(2,is)
119 fs(3) = a(3,is)
120 moms(1) = ar(1,is)
121 moms(2) = ar(2,is)
122 moms(3) = ar(3,is)
123 xms = ms(is)
124 ins = in(is)
125 stfn=stifn(is)
126 stfr=stifr(is)
127
128
129
130 fsloc(1) = rot(1)*fs(1) + rot(4)*fs(2) + rot(7)*fs(3)
131 fsloc(2) = rot(2)*fs(1) + rot(5)*fs(2) + rot(8)*fs(3)
132 fsloc(3) = rot(3)*fs(1) + rot(6)*fs(2) + rot(9)*fs(3)
133 fsloc(4) = rot(1)*moms(1) + rot(4)*moms(2) + rot(7)*moms(3)
134 fsloc(5) = rot(2)*moms(1) + rot(5)*moms(2) + rot(8)*moms(3)
135 fsloc(6) = rot(3)*moms(1) + rot(6)*moms(2) + rot(9)*moms(3)
136
137
138 DO jj=1,nir
139 fmloc(jj,1) = h(jj)*fsloc(1)
140 fmloc(jj,2) = h(jj)*fsloc(2)
141 fmloc(jj,3) = hh(jj)*fsloc(3)
142 . + hps(jj)*fsloc(4) + hpt(jj)*fsloc(5)
143 fmloc(jj,4) = hrs(jj)*fsloc(3)
144 . + hprs(jj)*fsloc(4)+ hxt(jj)*fsloc(5)
145 fmloc(jj,5) = hrt(jj)*fsloc(3)
146 . + hxs(jj)*fsloc(4) + hprt(jj)*fsloc(5)
147 fmloc(jj,6) = h(jj)*fsloc(6)
148 ENDDO
149
150 DO jj=1,nir
151 im = inod(jj)
152 len = sqrt((x(1,im)-xc)**2+(x(2,im)-yc)**2+(x(3,im)-zc)**2)
153
154 dm1 = h(jj) *xms
155 dm2 = hh(jj)*xms
156 . + hh(jj)*(sumhrs +sumhrt)*xms/len
157 . +(abs(hps(jj))*sumhprs + abs(hpt(jj))*sumhprt)*ins/len
158 IF (dm1 > dm2) THEN
159 dm(jj) = dm1
160 dstfn(jj) = h(jj)*stfn
161 ELSE
162 dm(jj) = dm2
163 dstfn(jj) = hh(jj)*stfn
164 . + hh(jj)*(sumhrs +sumhrt)*stfn/len
165 . +(abs(hps(jj))*sumhprs + abs(hpt(jj))*sumhprt)*stfr/len
166 ENDIF
167
168 din1 = abs(hrs(jj))*(sumhrs+sumhrt)*xms
169 . +(abs(hprs(jj))*sumhprs + abs(hxt(jj))*sumhprt)*ins
170 . + abs(hrs(jj))*xms*len
171 din2 = abs(hrt(jj))*(sumhrs+sumhrt)*xms
172 . +(abs(hprt(jj))*sumhprt + abs(hxs(jj))*sumhprs)*ins
173 . + abs(hrt(jj))*xms*len
174 din3 = h(jj)*ins
175 IF (din1 >= din2 .AND. din1 >= din3) THEN
176 din(jj) = din1
177 dstfr(jj) = abs(hrs(jj))*(sumhrs+sumhrt)*stfn
178 . +(abs(hprs(jj))*sumhprs + abs(hxt(jj))*sumhprt)*stfr
179 . + abs(hrs(jj))*stfn*len
180 ELSEIF (din2 >= din1 .AND. din2 >= din3) THEN
181 din(jj) = din2
182 dstfr(jj) = abs(hrt(jj))*(sumhrs+sumhrt)*stfn
183 . +(abs(hprt(jj))*sumhprt + abs(hxs(jj))*sumhprs)*stfr
184 . + abs(hrt(jj))*stfn*len
185 ELSEIF (din3 >= din1 .AND. din3 >= din2) THEN
186 din(jj) = din3
187 dstfr(jj) = h(jj)*stfr
188 ENDIF
189 ENDDO
190
191
192
193 DO jj=1,4
194 fx(jj) = roti(1)*fmloc
195 fy(jj) = roti(2)*fmloc(jj,1)+roti(5)*fmloc(jj,2)+roti(8)*fmloc(jj
196 fz(jj) = roti(3)*fmloc(jj,1)+roti(6)*fmloc(jj,2)+roti(9)*fmloc(jj,3)
197 ENDDO
198
199 i0 = i0 + 1
200 jj = 1
201 nn = iadi2(jj,i0)
202
203 fskyi2(1,nn) = fx(jj)
204 fskyi2(2,nn) = fy(jj)
205 fskyi2(3,nn) = fz(jj)
206 fskyi2(4,nn) = dm(jj)
207 fskyi2(5,nn) = dstfn(jj)
208 fskyi2(6,nn) =
209 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
210 fskyi2(7,nn) =
211 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
212 fskyi2(8,nn) =
213 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc
214 fskyi2(9,nn) = din(jj)
215 fskyi2(10,nn)= dstfr(jj)
216
217 jj = 2
218 nn = iadi2(jj,i0)
219 fskyi2(1,nn) = fx(jj)
220 fskyi2(2,nn) = fy(jj)
221 fskyi2(3,nn) = fz(jj)
222 fskyi2(4,nn) = dm(jj)
223 fskyi2(5,nn) = dstfn(jj)
224 fskyi2(6,nn) =
225 . roti(1)*fmloc(jj,
226 fskyi2(7,nn) =
227 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj
228 fskyi2(8,nn) =
229 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
230 fskyi2(9,nn) = din(jj)
231 fskyi2(10,nn)= dstfr(jj)
232
233 jj = 3
234 nn = iadi2(jj,i0)
235 fskyi2(1,nn) = fx(jj)
236 fskyi2(2,nn) = fy(jj)
237 fskyi2(3,nn) = fz(jj)
238 fskyi2(4,nn) = dm(jj)
239 fskyi2(5,nn) = dstfn(jj)
240 fskyi2(6,nn) =
241 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
242 fskyi2(7,nn) =
243 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6
244 fskyi2(8,nn) =
245 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
246 fskyi2(9,nn) = din(jj)
247 fskyi2(10,nn)= dstfr(jj)
248
249 jj = 4
250 nn = iadi2(jj,i0)
251 fskyi2(1,nn) = fx(jj)
252 fskyi2(2,nn) = fy(jj)
253 fskyi2(3,nn) = fz(jj)
254 fskyi2(4,nn) = dm(jj)
255 fskyi2(5,nn) = dstfn(jj)
256 fskyi2(6,nn) =
257 . roti(1)*fmloc(jj,4)+roti(4)*fmloc(jj,5)+roti(7)*fmloc(jj,6)
258 fskyi2(7,nn) =
259 . roti(2)*fmloc(jj,4)+roti(5)*fmloc(jj,5)+roti(8)*fmloc(jj,6)
260 fskyi2(8,nn) =
261 . roti(3)*fmloc(jj,4)+roti(6)*fmloc(jj,5)+roti(9)*fmloc(jj,6)
262 fskyi2(9,nn) = din(jj)
263 fskyi2(10,nn)= dstfr(jj)
264
265
267 . inod(1) ,nir ,fsav ,fncont ,fncontp,
268 . ftcontp ,weight ,h3d_data,is ,h)
269
270 IF (idel2/=0.AND.ms(is)/=zero) smass(ii)=ms(is)
271 IF (idel2/=0.AND.ms(is)/=zero) siner(ii)=in(is)
272 stifr(is)=em20
273 stifn(is)=em20
274 in(is) =zero
275 ms(is) =zero
276 a(1,is) =zero
277 a(2,is) =zero
278 a(3,is) =zero
279 ar(1,is) =zero
280 ar(2,is) =zero
281 ar(3,is) =zero
282
283 ENDIF
284 ELSEIF(weight(-is) == 1) THEN
285
286 i0 = i0 + 1
287 nn = iadi2(1,i0)
288 fskyi2(1,nn) = zero
289 fskyi2(2,nn) = zero
290 fskyi2(3,nn) = zero
291 fskyi2(4,nn) = zero
292 fskyi2(5,nn) = zero
293 fskyi2(6,nn) = zero
294 fskyi2(7,nn) = zero
295 fskyi2(8,nn) = zero
296 fskyi2(9,nn) = zero
297 fskyi2(10,nn)= zero
298 nn = iadi2(2,i0)
299 fskyi2(1,nn) = zero
300 fskyi2(2,nn) = zero
301 fskyi2(3,nn) = zero
302 fskyi2(4,nn) = zero
303 fskyi2(5,nn) = zero
304 fskyi2(6,nn) = zero
305 fskyi2(7,nn) = zero
306 fskyi2(8,nn) = zero
307 fskyi2(9,nn) = zero
308 fskyi2(10,nn)= zero
309 nn = iadi2(3,i0)
310 fskyi2(1,nn) = zero
311 fskyi2(2,nn) = zero
312 fskyi2(3,nn) = zero
313 fskyi2(4,nn) = zero
314 fskyi2(5,nn) = zero
315 fskyi2(6,nn) = zero
316 fskyi2(7,nn) = zero
317 fskyi2(8,nn) = zero
318 fskyi2(9,nn) = zero
319 fskyi2(10,nn)= zero
320 nn = iadi2(4,i0)
321 fskyi2(1,nn) = zero
322 fskyi2(2,nn) = zero
323 fskyi2(3,nn) = zero
324 fskyi2(4,nn) = zero
325 fskyi2(5,nn) = zero
326 fskyi2(6,nn) = zero
327 fskyi2(7,nn) = zero
328 fskyi2(8,nn) = zero
329 fskyi2(9,nn) = zero
330 fskyi2(10,nn)= zero
331 ENDIF
332 ENDDO
333
334 RETURN
subroutine i2curv_rep(inod, x, v, ls1, ls2, lt1, lt2, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)
subroutine i2forces(x, fs, fx, fy, fz, irect, nir, fsav, fncont, fncontp, ftcontp, weight, h3d_data, nsl, h)