42
43
44
45
48
49
50
51#include "implicit_f.inc"
52#include "comlock.inc"
53
54
55
56#include "mvsiz_p.inc"
57
58
59
60#include "scr07_c.inc"
61#include "scr14_c.inc"
62#include "scr16_c.inc"
63#include "com06_c.inc"
64#include "com08_c.inc"
65#include "parit_c.inc"
66#include "impl1_c.inc"
67
68
69
70 INTEGER IBC, IGIMP,LFT, LLT, NFT, IBAG, IADM
71 INTEGER MSR(*), NSV(*), IRTL(*), ICODT(*), ISKY(*),
72 . ICONTACT(*)
74 . e(*), stf(*), stfn(*), fsav(*),fskyi(lskyi,4),fcont(3,*),
75 . fncont(3,*)
76 TYPE(H3D_DATABASE) :: H3D_DATA
77 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX1,IX2,IX3,IX4
78 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: n1,n2,n3
79 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: h1,h2,h3,h4,thk
80 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: ans,stif,fni,xface
81
82
83
84 INTEGER I, IL, L, J3, J2, J1, IG,
85 . I3, I2, I1
86 INTEGER NISKYL
88 . fxi(mvsiz), fyi(mvsiz), fzi(mvsiz), fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
89 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz), fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz)
90
91
92 DO 100 i=lft,llt
93 ans(i)=
min(zero,(ans(i)*xface(i)-thk(i)))
94
95
96
97
98 IF(ans(i)==zero)xface(i)=zero
99 ans(i)=xface(i)*ans(i)
100 100 CONTINUE
101
102 igimp=0
103 DO 110 i=lft,llt
104 igimp=igimp+abs(xface(i))
105 110 CONTINUE
106 IF(igimp==0)RETURN
107
108 DO 140 i=lft,llt
109 il=i+nft
110 l=irtl(il)
111 stif(i)=half*stf(l)
112 140 CONTINUE
113
114 DO 150 i=lft,llt
115 fni(i)=ans(i)*stif(i)
116 fxi(i)=n1(i)*fni(i)
117 fyi(i)=n2(i)*fni(i)
118 fzi(i)=n3(i)*fni(i)
119 150 CONTINUE
120
121
122
123 DO 155 i=lft,llt
124 fsav(1)=fsav(1)+fxi(i)*dt12
125 fsav(2)=fsav(2)+fyi(i)*dt12
126 fsav(3)=fsav(3)+fzi(i)*dt12
127 155 CONTINUE
128
129 DO 160 i=lft,llt
130 fx1(i)=fxi(i)*h1(i)
131 fy1(i)=fyi(i)*h1(i)
132 fz1(i)=fzi(i)*h1(i)
133
134 fx2(i)=fxi(i)*h2(i)
135 fy2(i)=fyi(i)*h2(i)
136 fz2(i)=fzi(i)*h2(i)
137
138 fx3(i)=fxi(i)*h3(i)
139 fy3(i)=fyi(i)*h3(i)
140 fz3(i)=fzi(i)*h3(i)
141
142 fx4(i)=fxi(i)*h4(i)
143 fy4(i)=fyi(i)*h4(i)
144 fz4(i)=fzi(i)*h4(i)
145
146 160 CONTINUE
147
148 IF(iparit==0)THEN
149 DO 180 i=lft,llt
150 j3=3*ix1(i)
151 j2=j3-1
152 j1=j2-1
153 e(j1)=e(j1)+fx1(i)
154 e(j2)=e(j2)+fy1(i)
155 e(j3)=e(j3)+fz1(i)
156
157 j3=3*ix2(i)
158 j2=j3-1
159 j1=j2-1
160 e(j1)=e(j1)+fx2(i)
161 e(j2)=e(j2)+fy2(i)
162 e(j3)=e(j3)+fz2(i)
163
164 j3=3*ix3(i)
165 j2=j3-1
166 j1=j2-1
167 e(j1)=e(j1)+fx3(i)
168 e(j2)=e(j2)+fy3(i)
169 e(j3)=e(j3)+fz3(i)
170
171 j3=3*ix4(i)
172 j2=j3-1
173 j1=j2-1
174 e(j1)=e(j1)+fx4(i)
175 e(j2)=e(j2)+fy4(i)
176 e(j3)=e(j3)+fz4(i)
177
178 il=i+nft
179 ig=nsv(il)
180 i3=3*ig
181 i2=i3-1
182 i1=i2-1
183 e(i1)=e(i1)-fxi(i)
184 e(i2)=e(i2)-fyi(i)
185 e(i3)=e(i3)-fzi(i)
186 180 CONTINUE
187
188 ELSE
189
190#include "lockon.inc"
191 niskyl = nisky
192 nisky = nisky + 5 * llt
193#include "lockoff.inc"
194
195 DO 190 i=lft,llt
196 niskyl = niskyl + 1
197 fskyi(niskyl,1)=fx1(i)
198 fskyi(niskyl,2)=fy1(i)
199 fskyi(niskyl,3)=fz1(i)
200 fskyi(niskyl,4)=zero
201 isky(niskyl) = ix1(i)
202 niskyl = niskyl + 1
203 fskyi(niskyl,1)=fx2(i)
204 fskyi(niskyl,2)=fy2(i)
205 fskyi(niskyl,3)=fz2(i)
206 fskyi(niskyl,4)=zero
207 isky(niskyl) = ix2(i)
208 niskyl = niskyl + 1
209 fskyi(niskyl,1)=fx3(i)
210 fskyi(niskyl,2)=fy3(i)
211 fskyi(niskyl,3)=fz3(i)
212 fskyi(niskyl,4)=zero
213 isky(niskyl) = ix3(i)
214 niskyl = niskyl + 1
215 fskyi(niskyl,1)=fx4(i)
216 fskyi(niskyl,2)=fy4(i)
217 fskyi(niskyl,3)=fz4(i)
218 fskyi(niskyl,4)=zero
219 isky(niskyl) = ix4(i)
220 niskyl = niskyl + 1
221 fskyi(niskyl,1)=-fxi(i)
222 fskyi(niskyl,2)=-fyi(i)
223 fskyi(niskyl,3)=-fzi(i)
224 fskyi(niskyl,4)=zero
225 il=i+nft
226 isky(niskyl) = nsv(il)
227 190 CONTINUE
228 ENDIF
229
230 IF(inconv/=1) RETURN
231 IF(ibag/=0.OR.iadm/=0)THEN
232#include "lockon.inc"
233 DO i=lft,llt
234 il=i+nft
235 icontact(nsv(il))=1
236 icontact(ix1(i))=1
237 icontact(ix2(i))=1
238 icontact(ix3(i))=1
239 icontact(ix4(i))=1
240 ENDDO
241#include "lockoff.inc"
242 ENDIF
243
244 IF(anim_v(4)+outp_v(4)>0.AND.
245 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.
246 . (manim>=4.AND.manim<=15)))THEN
247#include "lockon.inc"
248 DO i=1,llt
249 fcont(1,ix1(i)) =fcont(1,ix1(i)) + fx1(i)
250 fcont(2,ix1(i)) =fcont(2,ix1(i)) + fy1(i)
251 fcont(3,ix1(i)) =fcont(3,ix1(i)) + fz1(i)
252 fcont(1,ix2(i)) =fcont(1,ix2(i)) + fx2(i)
253 fcont(2,ix2(i)) =fcont(2,ix2(i)) + fy2(i)
254 fcont(3,ix2(i)) =fcont(3,ix2(i)) + fz2(i)
255 fcont(1,ix3(i)) =fcont(1,ix3(i)) + fx3(i)
256 fcont(2,ix3(i)) =fcont(2,ix3(i)) + fy3(i)
257 fcont(3,ix3(i)) =fcont(3,ix3(i)) + fz3(i)
258 fcont(1,ix4(i)) =fcont(1,ix4(i)) + fx4(i)
259 fcont(2,ix4(i)) =fcont(2,ix4(i)) + fy4(i)
260 fcont(3,ix4(i)) =fcont(3,ix4(i)) + fz4(i)
261 fcont(1,nsv(i+nft))=fcont(1,nsv(i+nft))- fxi(i)
262 fcont(2,nsv(i+nft))=fcont(2,nsv(i+nft))- fyi(i)
263 fcont(3,nsv(i+nft))=fcont(3,nsv(i+nft))- fzi(i)
264 ENDDO
265#include "lockoff.inc"
266 ENDIF
267
268 IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT>0.AND.
269 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP
270 . (manim>=4.AND.manim<=15).OR.h3d_data%MH3D/=0))THEN
271#include "lockon.inc"
272 DO i=1,llt
273 fncont(1,ix1(i)) =fncont(1,ix1(i)) + fx1(i)
274 fncont(2,ix1(i)) =fncont(2,ix1(i)) + fy1(i)
275 fncont(3,ix1(i)) =fncont(3,ix1(i)) + fz1(i)
276 fncont(1,ix2(i)) =fncont(1,ix2(i)) + fx2(i)
277 fncont(2,ix2(i)) =fncont(2,ix2(i)) + fy2(i)
278 fncont(3,ix2(i)) =fncont(3,ix2(i)) + fz2(i)
279 fncont(1,ix3(i)) =fncont(1,ix3(i)) + fx3(i)
280 fncont(2,ix3(i)) =fncont(2,ix3(i)) + fy3(i)
281 fncont(3,ix3(i)) =fncont(3,ix3(i)) + fz3(i)
282 fncont(1,ix4(i)) =fncont(1,ix4(i)) + fx4(i)
283 fncont(2,ix4(i)) =fncont(2,ix4(i)) + fy4(i)
284 fncont(3,ix4(i)) =fncont(3,ix4(i)) + fz4(i)
285 fncont(1,nsv(i+nft))=fncont(1,nsv(i+nft))- fxi(i)
286 fncont(2,nsv(i+nft))=fncont(2,nsv(i+nft))- fyi(i)
287 fncont(3,nsv(i+nft))=fncont(3,nsv(i+nft))- fzi(i)
288 ENDDO
289#include "lockoff.inc"
290 ENDIF
291
292 IF(ibc==0) RETURN
293 DO 200 i=lft,llt
294 IF(ibc==0.OR.xface(i)==zero)GOTO 200
295 il=i+nft
296 ig=nsv(il)
297 CALL ibcoff(ibc,icodt(ig))
298 200 CONTINUE
299
300 RETURN
subroutine ibcoff(ibc, icodt)