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