OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i8for3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "scr07_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "parit_c.inc"
#include "scr18_c.inc"
#include "remesh_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i8for3 (lft, llt, nft, e, msr, nsv, irtl, stf, nsvglo, nsv2, iloc, stfn, ibc, icodt, fsav, igimp, x, v, ms, fmax, nsn, fskyi, isky, fcont, rcontact, iform, ftsavx, ftsavy, ftsavz, visc, fnor, depth, dist, gapn, slopen, stifn, fncont, ftcont, itab, ift0, ix1, ix2, ix3, ix4, xi, yi, zi, n1, n2, n3, ans, ssc, ttc, h1, h2, h3, h4, xface, stif, fni, fxi, fyi, fzi, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, thk, h3d_data, ninskid, ninterskid, pskids, irect, nin, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, iflinear, fric_last, fnor_last, distlin)

Function/Subroutine Documentation

◆ i8for3()

subroutine i8for3 ( integer lft,
integer llt,
integer nft,
e,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
stf,
integer, dimension(*) nsvglo,
integer, dimension(*) nsv2,
integer, dimension(*) iloc,
stfn,
integer ibc,
integer, dimension(*) icodt,
fsav,
integer igimp,
x,
v,
ms,
fmax,
integer nsn,
fskyi,
integer, dimension(*) isky,
fcont,
rcontact,
integer iform,
ftsavx,
ftsavy,
ftsavz,
visc,
fnor,
depth,
dist,
gapn,
slopen,
stifn,
fncont,
ftcont,
integer, dimension(*) itab,
integer ift0,
integer, dimension(*) ix1,
integer, dimension(*) ix2,
integer, dimension(*) ix3,
integer, dimension(*) ix4,
xi,
yi,
zi,
n1,
n2,
n3,
ans,
ssc,
ttc,
h1,
h2,
h3,
h4,
xface,
stif,
fni,
fxi,
fyi,
fzi,
fx1,
fy1,
fz1,
fx2,
fy2,
fz2,
fx3,
fy3,
fz3,
fx4,
fy4,
fz4,
thk,
type(h3d_database) h3d_data,
integer ninskid,
integer ninterskid,
pskids,
integer, dimension(4,*) irect,
integer nin,
integer, dimension(nloadp_hyd_inter,numnod) tagncont,
integer, dimension(ninter+1) kloadpinter,
integer, dimension(ninter*nloadp_hyd) loadpinter,
integer, dimension(nloadp_hyd) loadp_hyd_inter,
integer, intent(in) iflinear,
intent(in) fric_last,
intent(in) fnor_last,
dimension(nsn), intent(in) distlin )

Definition at line 33 of file i8for3.F.

57C-----------------------------------------------
58C M o d u l e s
59C-----------------------------------------------
60 USE h3d_mod
61 USE anim_mod
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66#include "comlock.inc"
67C-----------------------------------------------
68C C o m m o n B l o c k s
69C-----------------------------------------------
70#include "scr07_c.inc"
71#include "scr14_c.inc"
72#include "scr16_c.inc"
73#include "com04_c.inc"
74#include "com06_c.inc"
75#include "com08_c.inc"
76#include "parit_c.inc"
77#include "scr18_c.inc"
78#include "remesh_c.inc"
79C-----------------------------------------------
80C D u m m y A r g u m e n t s
81C-----------------------------------------------
82 INTEGER IBC, IGIMP, NSN,LFT, LLT, NFT, IFORM,IFT0,NINSKID ,NINTERSKID,NIN
83 INTEGER MSR(*), NSV(*), IRTL(*), ICODT(*), ISKY(*),ITAB(*)
84 INTEGER NSVGLO(*),NSV2(*),ILOC(*),IRECT(4,*)
85C REAL
86 INTEGER IX1(*), IX2(*), IX3(*), IX4(*),
87 . TAGNCONT(NLOADP_HYD_INTER,NUMNOD),
88 . KLOADPINTER(NINTER+1),LOADPINTER(NINTER*NLOADP_HYD),
89 . LOADP_HYD_INTER(NLOADP_HYD)
90 INTEGER , INTENT(IN) :: IFLINEAR
91 my_real
92 . e(*), stf(*), stfn(*), fsav(*), x(3,*),v(3,*),ms(*),
93 . fskyi(lskyi,nfskyi),fcont(3,*),fmax, rcontact(*),
94 . ftsavx(*), ftsavy(*), ftsavz(*), visc,slopen(*),
95 . fnor,depth,dist(*),gapn(*),stifn(*),fncont(3,*),ftcont(3,*),
96 . pskids(ninterskid,*)
97 my_real
98 . xi(*), yi(*), zi(*), n1(*), n2(*), n3(*), ans(*), ssc(*),
99 . ttc(*), thk(*), h1(*), h2(*), h3(*), h4(*), xface(*), stif(*),
100 . fxi(*), fyi(*), fzi(*), fni(*), fx1(*), fx2(*), fx3(*), fx4(*),
101 . fy1(*), fy2(*), fy3(*), fy4(*), fz1(*), fz2(*), fz3(*), fz4(*)
102 my_real , INTENT(IN) :: fric_last,fnor_last,distlin(nsn)
103 TYPE(H3D_DATABASE) :: H3D_DATA
104
105C-----------------------------------------------
106C L o c a l V a r i a b l e s
107C-----------------------------------------------
108 INTEGER I, IL, L, J3, J2, J1, IG,
109 . I3, I2, I1,JL,JG,J,NN, PP, PPL,K
110 INTEGER NISKYL
111 my_real
112 . nx,ny,nz,lx,ly,lz,nx2,cc2,st,li2(nsn),
113 . vx(nsn),vy(nsn),vz(nsn),vv(nsn),vn(nsn),
114 . nn1(nsn),nn2(nsn),nn3(nsn),fnni(nsn),nnx,
115 . felast, ftry, deltag, dt1inv, vis2,pen(nsn),ffac,
116 . fnlim, ftlim,
117 . fnxi(nsn),fnyi(nsn),fnzi(nsn),fnx1(nsn),fny1(nsn),
118 . fnz1(nsn),fnx2(nsn),fny2(nsn),fnz2(nsn),fnx3(nsn),
119 . fny3(nsn),fnz3(nsn),fnx4(nsn),fny4(nsn),fnz4(nsn),
120 . ftxi(nsn),ftyi(nsn),ftzi(nsn),ftx1(nsn),fty1(nsn),
121 . ftz1(nsn),ftx2(nsn),fty2(nsn),ftz2(nsn),ftx3(nsn),
122 . fty3(nsn),ftz3(nsn),ftx4(nsn),fty4(nsn),ftz4(nsn)
123C---------------------------------------------
124 ftlim = fmax
125 fnlim = fnor
126
127C--------------Before Nj change----
128 IF(fnor /=zero) THEN
129 DO i=lft,llt
130 nn1(i) = n1(i)
131 nn2(i) = n2(i)
132 nn3(i) = n3(i)
133 END DO
134 END IF
135C--------------Pene computation----
136 IF(depth > zero) THEN
137 DO i=lft,llt
138 il=i+nft
139 l=irtl(il)
140 pen(i) = zero
141 IF(l > 0) THEN
142 pen(i) = (depth - dist(i) + gapn(l))*abs(xface(i))
143 ENDIF
144 END DO
145 ELSE
146 DO i=lft,llt
147 pen(i) = one
148 ENDDO
149 END IF
150
151C-------Output Skid line for type 8 ----
152 IF(ninskid > 0) THEN
153 DO i=lft,llt
154 il=i+nft
155 l=irtl(il)
156 IF(l > 0.AND.pen(i)>zero) THEN
157 DO j=1,4
158 nn=msr(irect(j,l))
159 pskids(ninskid,nn) = one
160 ENDDO
161 ENDIF
162 ENDDO
163 ENDIF
164
165C------------For /LOAD/PRESSURE tag nodes in contact-------------
166 IF(nintloadp > 0) THEN
167 DO k = kloadpinter(nin)+1, kloadpinter(nin+1)
168 pp = loadpinter(k)
169 ppl = loadp_hyd_inter(pp)
170 DO i=lft,llt
171 il=i+nft
172 l=irtl(il)
173 IF(l > 0.AND.pen(i)>zero) THEN
174 DO j=1,4
175 nn=msr(irect(j,l))
176 tagncont(ppl,nn) = 1
177 ENDDO
178 ENDIF
179 ENDDO
180 ENDDO
181
182 ENDIF
183
184 DO i=lft,llt
185 fxi(i) = zero
186 fyi(i) = zero
187 fzi(i) = zero
188 ENDDO
189
190C
191C-------------------------------
192C RESTRAINING FORCE
193C-------------------------------
194 SELECT CASE(iform)
195C
196 CASE(1)
197C-------------------
198C VISCOOUS FORMULATION
199C-------------------
200 DO i=lft,llt
201 IF(pen(i)>zero) THEN
202 il=i+nft
203 ig=nsv(il)
204 i1 = nsvglo(max(1,nsv2(il)-1))
205 i2 = nsvglo(min(nsn,nsv2(il)+1))
206c
207 lx = half*(x(1,i2)-x(1,i1))
208 ly = half*(x(2,i2)-x(2,i1))
209 lz = half*(x(3,i2)-x(3,i1))
210c
211 nx = n2(i)*lz - n3(i)*ly
212 ny = n3(i)*lx - n1(i)*lz
213 nz = n1(i)*ly - n2(i)*lx
214c
215c (vitesse SECONDARY = 0)
216 vx(i) = v(1,ix1(i))*h1(i) + v(1,ix2(i))*h2(i)
217 . + v(1,ix3(i))*h3(i) + v(1,ix4(i))*h4(i)
218 vy(i) = v(2,ix1(i))*h1(i) + v(2,ix2(i))*h2(i)
219 . + v(2,ix3(i))*h3(i) + v(2,ix4(i))*h4(i)
220 vz(i) = v(3,ix1(i))*h1(i) + v(3,ix2(i))*h2(i)
221 . + v(3,ix3(i))*h3(i) + v(3,ix4(i))*h4(i)
222 vv(i) = vx(i)*nx + vy(i)*ny + vz(i)*nz
223 IF(vv(i)<zero)THEN
224 nx=-nx
225 ny=-ny
226 nz=-nz
227 vv(i)=-vv(i)
228 ENDIF
229C
230 n1(i)=nx
231 n2(i)=ny
232 n3(i)=nz
233 ENDIF
234 END DO
235C
236 DO 150 i=lft,llt
237 IF(pen(i)>zero) THEN
238 il=i+nft
239 ig=nsv2(il)
240 l=irtl(il)
241 cc2 = stf(l)
242 . *fourth*( ms(ix1(i))+ms(ix2(i))+ms(ix3(i))+ms(ix4(i)) )
243 nx2 = max(em20,n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i))
244 li2(i)=nx2
245 fni(i)= vv(i)*sqrt(cc2/nx2)*abs(xface(i))
246 IF(fric_last/= zero) THEN
247 ftlim = fmax + (distlin(ig)/distlin(nsn))*(fric_last-fmax)
248 ENDIF
249 IF(fni(i)>ftlim)THEN
250 fni(i)= ftlim
251 ENDIF
252C
253 fni(i)= - fni(i)
254 fxi(i)=n1(i)*fni(i)
255 fyi(i)=n2(i)*fni(i)
256 fzi(i)=n3(i)*fni(i)
257 ENDIF
258
259 150 CONTINUE
260C
261 CASE(2)
262C-------------------
263C INCREMENTAL FORMULATION FOR TANGENTIAL FORCE
264C-------------------
265 ! A Reecrire pour le parallele
266 DO i=lft,llt
267 il=i+nft
268 ig=nsv(il)
269 IF(pen(i)>zero) THEN
270 !IF the proc MAIN handles the face
271 i1 = nsvglo(max(1,nsv2(il)-1))
272 i2 = nsvglo(min(nsn,nsv2(il)+1))
273c
274 lx = half*(x(1,i2)-x(1,i1))
275 ly = half*(x(2,i2)-x(2,i1))
276 lz = half*(x(3,i2)-x(3,i1))
277c
278 nx = n2(i)*lz - n3(i)*ly
279 ny = n3(i)*lx - n1(i)*lz
280 nz = n1(i)*ly - n2(i)*lx
281c
282c (vitesse SECONDARY = 0)
283 vx(i) = v(1,ix1(i))*h1(i) + v(1,ix2(i))*h2(i)
284 . + v(1,ix3(i))*h3(i) + v(1,ix4(i))*h4(i)
285 vy(i) = v(2,ix1(i))*h1(i) + v(2,ix2(i))*h2(i)
286 . + v(2,ix3(i))*h3(i) + v(2,ix4(i))*h4(i)
287 vz(i) = v(3,ix1(i))*h1(i) + v(3,ix2(i))*h2(i)
288 . + v(3,ix3(i))*h3(i) + v(3,ix4(i))*h4(i)
289C
290 vv(i) = vx(i)*nx + vy(i)*ny + vz(i)*nz
291 IF(vv(i)<zero)THEN
292 nx=-nx
293 ny=-ny
294 nz=-nz
295 vv(i)=-vv(i)
296 ENDIF
297C
298 n1(i)=nx
299 n2(i)=ny
300 n3(i)=nz
301 ENDIF
302 ENDDO
303C
304 IF(dt1>zero)THEN
305 dt1inv = one/dt1
306 ELSE
307 dt1inv =zero
308 ENDIF
309 vis2=visc*visc
310C
311 DO i=lft,llt
312 il=i+nft
313 ! Global ID of the salve node
314 ig=nsv2(il)
315 l=irtl(il)
316C
317 IF(pen(i)>zero) THEN
318 st = stf(l)
319 cc2 = vis2*stf(l)
320 . * fourth*( ms(ix1(i))+ms(ix2(i))+ms(ix3(i))+ms(ix4(i)) )
321C
322 fxi(i)=(ftsavx(ig)+st*vx(i)*dt1)*abs(xface(i))
323 fyi(i)=(ftsavy(ig)+st*vy(i)*dt1)*abs(xface(i))
324 fzi(i)=(ftsavz(ig)+st*vz(i)*dt1)*abs(xface(i))
325C
326 nx2 =max(em20,n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i))
327 li2(i)=nx2
328 nx2 =one/nx2
329 felast =(fxi(i)*n1(i)+fyi(i)*n2(i)+fzi(i)*n3(i))*nx2
330C
331 ftry =felast+sqrt(cc2*nx2)*vv(i)*abs(xface(i))
332
333 IF(fric_last/= zero) THEN
334 ftlim = fmax + (distlin(ig)/distlin(nsn))*(fric_last-fmax)
335 ENDIF
336
337 fni(i) =sign(min(abs(ftry),ftlim),ftry)
338
339C
340C slidinnng (per unit length)
341 deltag =(ftry-fni(i))/max(em20,st+sqrt(cc2)*dt1inv)
342 felast =felast-st*deltag
343C
344C save eeelastic force
345 ftsavx(ig)=felast*n1(i)
346 ftsavy(ig)=felast*n2(i)
347 ftsavz(ig)=felast*n3(i)
348C
349 fni(i)= - fni(i)
350 fxi(i)= fni(i)*n1(i)
351 fyi(i)= fni(i)*n2(i)
352 fzi(i)= fni(i)*n3(i)
353 ENDIF
354
355 END DO
356C
357 END SELECT
358
359C------- For Post-precessing
360 DO i=lft,llt
361 ftxi(i)= fxi(i)
362 ftyi(i)= fyi(i)
363 ftzi(i)= fzi(i)
364 ENDDO
365C-------------------------------
366C NORMAL FORCE
367C-------------------------------
368c SLOPE = ZERO
369c IF(FNOR/=0) SLOPE = FNOR/MAX(DEPTH,EM20)
370c
371 fnni = zero
372 IF(fnor /=zero) THEN
373 DO i=lft,llt
374 il=i+nft
375 !Global SECONDARY index
376 ig=nsv2(il)
377 l=irtl(il)
378 IF(irtl(il) > 0) THEN
379c PEN(I) = (DEPTH - DIST(I) + GAPN(L))*ABS(XFACE(I))
380C
381 IF(fnor_last/= zero) THEN
382 fnlim = fnor + (distlin(ig)/distlin(nsn))*(fnor_last-fnor)
383 ENDIF
384 IF(pen(i)>=depth) THEN
385 fnni(i)= fnlim*sqrt(li2(i))
386 ELSEIF(pen(i)>zero) THEN
387 fnni(i)= slopen(ig)*pen(i)*sqrt(li2(i))
388C----restraining force reducing
389 IF(ift0==0 .AND. slopen(ig)<stf(l)) THEN
390 ffac = pen(i)/depth
391 fxi(i)= ffac*fxi(i)
392 fyi(i)= ffac*fyi(i)
393 fzi(i)= ffac*fzi(i)
394 END IF
395 ENDIF
396 fnxi(i)= - nn1(i)*fnni(i)
397 fnyi(i)= - nn2(i)*fnni(i)
398 fnzi(i)= - nn3(i)*fnni(i)
399 ENDIF
400 ENDDO
401C------- For Post-precessing
402 DO i=lft,llt
403 ftxi(i)= fxi(i)
404 ftyi(i)= fyi(i)
405 ftzi(i)= fzi(i)
406 ENDDO
407C-----add normal forces
408 DO i=lft,llt
409 fxi(i)= fxi(i) + fnxi(i)
410 fyi(i)= fyi(i) + fnyi(i)
411 fzi(i)= fzi(i) + fnzi(i)
412 ENDDO
413 ELSE
414 DO i=lft,llt
415 fnxi(i)= zero
416 fnyi(i)= zero
417 fnzi(i)= zero
418 ENDDO
419 ENDIF
420C---------------------------------
421C SAUVEGARDE DE L'IMPULSION TOTALE
422C---------------------------------
423 DO 155 i=lft,llt
424 fsav(1)=fsav(1)+fnxi(i)*dt12
425 fsav(2)=fsav(2)+fnyi(i)*dt12
426 fsav(3)=fsav(3)+fnzi(i)*dt12
427
428 fsav(4)=fsav(4)+ftxi(i)*dt12
429 fsav(5)=fsav(5)+ftyi(i)*dt12
430 fsav(6)=fsav(6)+ftzi(i)*dt12
431
432 fsav(8)=fsav(8)+abs(fnxi(i))*dt12
433 fsav(9)=fsav(9)+abs(fnyi(i))*dt12
434 fsav(10)=fsav(10)+abs(fnzi(i))*dt12
435 fsav(11)=fsav(11)+fni(i)*dt12
436
437 fsav(12)=fsav(12)+abs(fxi(i))*dt12
438 fsav(13)=fsav(13)+abs(fyi(i))*dt12
439 fsav(14)=fsav(14)+abs(fzi(i))*dt12
440 fsav(15) = fsav(15) +sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))*dt12
441 155 CONTINUE
442C
443 DO 160 i=lft,llt
444 fx1(i)=fxi(i)*h1(i)
445 fy1(i)=fyi(i)*h1(i)
446 fz1(i)=fzi(i)*h1(i)
447C
448 fx2(i)=fxi(i)*h2(i)
449 fy2(i)=fyi(i)*h2(i)
450 fz2(i)=fzi(i)*h2(i)
451C
452 fx3(i)=fxi(i)*h3(i)
453 fy3(i)=fyi(i)*h3(i)
454 fz3(i)=fzi(i)*h3(i)
455C
456 fx4(i)=fxi(i)*h4(i)
457 fy4(i)=fyi(i)*h4(i)
458 fz4(i)=fzi(i)*h4(i)
459C
460 fnx1(i)=fnxi(i)*h1(i)
461 fny1(i)=fnyi(i)*h1(i)
462 fnz1(i)=fnzi(i)*h1(i)
463C
464 fnx2(i)=fnxi(i)*h2(i)
465 fny2(i)=fnyi(i)*h2(i)
466 fnz2(i)=fnzi(i)*h2(i)
467C
468 fnx3(i)=fnxi(i)*h3(i)
469 fny3(i)=fnyi(i)*h3(i)
470 fnz3(i)=fnzi(i)*h3(i)
471C
472 fnx4(i)=fnxi(i)*h4(i)
473 fny4(i)=fnyi(i)*h4(i)
474 fnz4(i)=fnzi(i)*h4(i)
475C
476 ftx1(i)=ftxi(i)*h1(i)
477 fty1(i)=ftyi(i)*h1(i)
478 ftz1(i)=ftzi(i)*h1(i)
479C
480 ftx2(i)=ftxi(i)*h2(i)
481 fty2(i)=ftyi(i)*h2(i)
482 ftz2(i)=ftzi(i)*h2(i)
483C
484 ftx3(i)=ftxi(i)*h3(i)
485 fty3(i)=ftyi(i)*h3(i)
486 ftz3(i)=ftzi(i)*h3(i)
487C
488 ftx4(i)=ftxi(i)*h4(i)
489 fty4(i)=ftyi(i)*h4(i)
490 ftz4(i)=ftzi(i)*h4(i)
491C
492
493
494
495 160 CONTINUE
496C
497 IF(iparit==0)THEN
498 DO 180 i=lft,llt
499 j3=3*ix1(i)
500 j2=j3-1
501 j1=j2-1
502 e(j1)=e(j1)+fx1(i)
503 e(j2)=e(j2)+fy1(i)
504 e(j3)=e(j3)+fz1(i)
505c STIFN(J1) = STIFN(J1) + SLOPE*ABS(H1(I))
506C
507 j3=3*ix2(i)
508 j2=j3-1
509 j1=j2-1
510 e(j1)=e(j1)+fx2(i)
511 e(j2)=e(j2)+fy2(i)
512 e(j3)=e(j3)+fz2(i)
513c STIFN(J1) = STIFN(J1) + SLOPE*ABS(H2(I))
514C
515 j3=3*ix3(i)
516 j2=j3-1
517 j1=j2-1
518 e(j1)=e(j1)+fx3(i)
519 e(j2)=e(j2)+fy3(i)
520 e(j3)=e(j3)+fz3(i)
521c STIFN(J1) = STIFN(J1) + SLOPE*ABS(H3(I))
522C
523 j3=3*ix4(i)
524 j2=j3-1
525 j1=j2-1
526 e(j1)=e(j1)+fx4(i)
527 e(j2)=e(j2)+fy4(i)
528 e(j3)=e(j3)+fz4(i)
529c STIFN(J1) = STIFN(J1) + SLOPE*ABS(H4(I))
530C
531 il=i+nft
532 ig=nsv(il)
533 i3=3*ig
534 i2=i3-1
535 i1=i2-1
536 e(i1)=e(i1)-fxi(i)
537 e(i2)=e(i2)-fyi(i)
538 e(i3)=e(i3)-fzi(i)
539c STIFN(I1) = STIFN(I1) + SLOPE
540 180 CONTINUE
541C
542 ELSE
543C
544#include "lockon.inc"
545 niskyl = nisky
546 nisky = nisky + 5 * llt
547#include "lockoff.inc"
548C
549 IF(kdtint==0)THEN
550 DO 190 i=lft,llt
551 niskyl = niskyl + 1
552 fskyi(niskyl,1)=fx1(i)
553 fskyi(niskyl,2)=fy1(i)
554 fskyi(niskyl,3)=fz1(i)
555 fskyi(niskyl,4)=zero !SLOPE
556 isky(niskyl) = ix1(i)
557 niskyl = niskyl + 1
558 fskyi(niskyl,1)=fx2(i)
559 fskyi(niskyl,2)=fy2(i)
560 fskyi(niskyl,3)=fz2(i)
561 fskyi(niskyl,4)=zero !SLOPE
562 isky(niskyl) = ix2(i)
563 niskyl = niskyl + 1
564 fskyi(niskyl,1)=fx3(i)
565 fskyi(niskyl,2)=fy3(i)
566 fskyi(niskyl,3)=fz3(i)
567 fskyi(niskyl,4)=zero !SLOPE
568 isky(niskyl) = ix3(i)
569 niskyl = niskyl + 1
570 fskyi(niskyl,1)=fx4(i)
571 fskyi(niskyl,2)=fy4(i)
572 fskyi(niskyl,3)=fz4(i)
573 fskyi(niskyl,4)=zero !SLOPE
574 isky(niskyl) = ix4(i)
575 niskyl = niskyl + 1
576 fskyi(niskyl,1)=-fxi(i)
577 fskyi(niskyl,2)=-fyi(i)
578 fskyi(niskyl,3)=-fzi(i)
579 fskyi(niskyl,4)=zero !SLOPE
580 il=i+nft
581 isky(niskyl) = nsv(il)
582 190 CONTINUE
583 ELSE
584 DO i=lft,llt
585 niskyl = niskyl + 1
586 fskyi(niskyl,1)=fx1(i)
587 fskyi(niskyl,2)=fy1(i)
588 fskyi(niskyl,3)=fz1(i)
589 fskyi(niskyl,4)=zero !SLOPE
590 fskyi(niskyl,5)=zero
591 isky(niskyl) = ix1(i)
592 niskyl = niskyl + 1
593 fskyi(niskyl,1)=fx2(i)
594 fskyi(niskyl,2)=fy2(i)
595 fskyi(niskyl,3)=fz2(i)
596 fskyi(niskyl,4)=zero !SLOPE
597 fskyi(niskyl,5)=zero
598 isky(niskyl) = ix2(i)
599 niskyl = niskyl + 1
600 fskyi(niskyl,1)=fx3(i)
601 fskyi(niskyl,2)=fy3(i)
602 fskyi(niskyl,3)=fz3(i)
603 fskyi(niskyl,4)=zero !SLOPE
604 fskyi(niskyl,5)=zero
605 isky(niskyl) = ix3(i)
606 niskyl = niskyl + 1
607 fskyi(niskyl,1)=fx4(i)
608 fskyi(niskyl,2)=fy4(i)
609 fskyi(niskyl,3)=fz4(i)
610 fskyi(niskyl,4)=zero !SLOPE
611 fskyi(niskyl,5)=zero
612 isky(niskyl) = ix4(i)
613 niskyl = niskyl + 1
614 fskyi(niskyl,1)=-fxi(i)
615 fskyi(niskyl,2)=-fyi(i)
616 fskyi(niskyl,3)=-fzi(i)
617 fskyi(niskyl,4)=zero !SLOPE
618 fskyi(niskyl,5)=zero
619 il=i+nft
620 isky(niskyl) = nsv(il)
621 ENDDO
622 ENDIF
623 ENDIF
624 IF(nadmesh/=0)THEN
625#include "lockon.inc"
626 DO i=1,llt
627 IF(xface(i)/=zero)THEN
628 rcontact(ix1(i))=zero
629 rcontact(ix2(i))=zero
630 rcontact(ix3(i))=zero
631 rcontact(ix4(i))=zero
632 END IF
633 ENDDO
634#include "lockoff.inc"
635 END IF
636C
637 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0.AND.
638 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
639 . (manim>=4.AND.manim<=15).OR. h3d_data%MH3D /= 0))THEN
640#include "lockon.inc"
641 DO i=1,llt
642 fcont(1,ix1(i)) =fcont(1,ix1(i)) + fx1(i)
643 fcont(2,ix1(i)) =fcont(2,ix1(i)) + fy1(i)
644 fcont(3,ix1(i)) =fcont(3,ix1(i)) + fz1(i)
645 fcont(1,ix2(i)) =fcont(1,ix2(i)) + fx2(i)
646 fcont(2,ix2(i)) =fcont(2,ix2(i)) + fy2(i)
647 fcont(3,ix2(i)) =fcont(3,ix2(i)) + fz2(i)
648 fcont(1,ix3(i)) =fcont(1,ix3(i)) + fx3(i)
649 fcont(2,ix3(i)) =fcont(2,ix3(i)) + fy3(i)
650 fcont(3,ix3(i)) =fcont(3,ix3(i)) + fz3(i)
651 fcont(1,ix4(i)) =fcont(1,ix4(i)) + fx4(i)
652 fcont(2,ix4(i)) =fcont(2,ix4(i)) + fy4(i)
653 fcont(3,ix4(i)) =fcont(3,ix4(i)) + fz4(i)
654 fcont(1,nsv(i+nft))=fcont(1,nsv(i+nft))- fxi(i)
655 fcont(2,nsv(i+nft))=fcont(2,nsv(i+nft))- fyi(i)
656 fcont(3,nsv(i+nft))=fcont(3,nsv(i+nft))- fzi(i)
657C
658 ENDDO
659#include "lockoff.inc"
660 ENDIF
661 IF((anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT>0.AND.
662 . ((tt>=tanim .AND. tt<=tanim_stop).OR.tt>=toutp.OR.(tt>=h3d_data%TH3D.AND.tt<=h3d_data%TH3D_STOP).OR.
663 . (manim>=4.AND.manim<=15).OR.h3d_data%MH3D/=0))
664 . .OR.h3d_data%N_VECT_PCONT_MAX>0)THEN
665#include "lockon.inc"
666 DO i=1,llt
667 fncont(1,ix1(i)) =fncont(1,ix1(i)) + fnx1(i)
668 fncont(2,ix1(i)) =fncont(2,ix1(i)) + fny1(i)
669 fncont(3,ix1(i)) =fncont(3,ix1(i)) + fnz1(i)
670 fncont(1,ix2(i)) =fncont(1,ix2(i)) + fnx2(i)
671 fncont(2,ix2(i)) =fncont(2,ix2(i)) + fny2(i)
672 fncont(3,ix2(i)) =fncont(3,ix2(i)) + fnz2(i)
673 fncont(1,ix3(i)) =fncont(1,ix3(i)) + fnx3(i)
674 fncont(2,ix3(i)) =fncont(2,ix3(i)) + fny3(i)
675 fncont(3,ix3(i)) =fncont(3,ix3(i)) + fnz3(i)
676 fncont(1,ix4(i)) =fncont(1,ix4(i)) + fnx4(i)
677 fncont(2,ix4(i)) =fncont(2,ix4(i)) + fny4(i)
678 fncont(3,ix4(i)) =fncont(3,ix4(i)) + fnz4(i)
679
680 fncont(1,nsv(i+nft))=fncont(1,nsv(i+nft))- fnxi(i)
681 fncont(2,nsv(i+nft))=fncont(2,nsv(i+nft))- fnyi(i)
682 fncont(3,nsv(i+nft))=fncont(3,nsv(i+nft))- fnzi(i)
683C
684 ftcont(1,ix1(i)) =ftcont(1,ix1(i)) + ftx1(i)
685 ftcont(2,ix1(i)) =ftcont(2,ix1(i)) + fty1(i)
686 ftcont(3,ix1(i)) =ftcont(3,ix1(i)) + ftz1(i)
687 ftcont(1,ix2(i)) =ftcont(1,ix2(i)) + ftx2(i)
688 ftcont(2,ix2(i)) =ftcont(2,ix2(i)) + fty2(i)
689 ftcont(3,ix2(i)) =ftcont(3,ix2(i)) + ftz2(i)
690 ftcont(1,ix3(i)) =ftcont(1,ix3(i)) + ftx3(i)
691 ftcont(2,ix3(i)) =ftcont(2,ix3(i)) + fty3(i)
692 ftcont(3,ix3(i)) =ftcont(3,ix3(i)) + ftz3(i)
693 ftcont(1,ix4(i)) =ftcont(1,ix4(i)) + ftx4(i)
694 ftcont(2,ix4(i)) =ftcont(2,ix4(i)) + fty4(i)
695 ftcont(3,ix4(i)) =ftcont(3,ix4(i)) + ftz4(i)
696
697 ftcont(1,nsv(i+nft))=ftcont(1,nsv(i+nft))- ftxi(i)
698 ftcont(2,nsv(i+nft))=ftcont(2,nsv(i+nft))- ftyi(i)
699 ftcont(3,nsv(i+nft))=ftcont(3,nsv(i+nft))- ftzi(i)
700 ENDDO
701#include "lockoff.inc"
702 ENDIF
703C
704 IF(ibc==0) RETURN
705 DO 200 i=lft,llt
706 IF(ibc==0.OR.xface(i)==zero)GOTO 200
707 il=i+nft
708 ig=nsv(il)
709 CALL ibcoff(ibc,icodt(ig))
710 200 CONTINUE
711C
712 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
ibcoff
subroutine ibcoff(ibc, icodt)
Definition ibcoff.F:44
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
anim_mod
Definition anim_mod.F:96
h3d_mod
Definition h3d_mod.F:308