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