OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i17lagm.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "task_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i17lagm (x, v, lll, jll, sll, xll, candn, cande, i_stok, ixs, ixs16, iadll, eminx, neles, nelem, nc, n_mul_mx, itask, a, itied, nint, nkmax, eminxs, comntag)
subroutine i17lll (llt, lll, jll, sll, xll, v, xx, yy, zz, iii, nc, iadll, n_mul_mx, a, x, itied, nint, nkmax, xxs, yys, zzs, iiis, nc_sav, vit_min, ie, ies, ie_min, ies_min, itask, comntag)
subroutine i17vit4 (llt, nint, v, a, iii, iiis, ni_m, ni_s, nx, ny, nz, vit, icont, rm, tm, rs, ts, sm, r_m, t_m, r_s, t_s, icontn)
subroutine i17lll4 (llt, lll, jll, sll, xll, n_mul_mx, itied, nint, nkmax, nc, v, a, iadll, iii, iiis, ni_m, ni_s, nx, ny, nz, vit, comntag, icont, rm, tm, rs, ts)
subroutine i17rst (llt, r, s, t, ni, xx, yy, zz)
subroutine i17mini (llt, r_cs, s_cs, t_cs, ri_s, si_s, ti_s, ni_s, xxs, yys, zzs, xx, yy, zz, r_cm, s_cm, t_cm, nx, ny, nz, r_1s, r_2s, t_1s, t_2s, r_1m, r_2m, r_3m, r_4m, t_1m, t_2m, t_3m, t_4m, icont)
subroutine i17ni (llt, r, t, ni)
subroutine i17racine (llt, a, b, c, r1, r2)
subroutine i17borne (llt, r_s, a, b, c, icont, rs)
subroutine i17abc (llt, f, r, t, b1, b2, b3, c1, c2, c3)
subroutine i17norm (llt, rr, ss, tt, nx, ny, nz, xx, yy, zz)

Function/Subroutine Documentation

◆ i17abc()

subroutine i17abc ( integer llt,
f,
r,
t,
b1,
b2,
b3,
c1,
c2,
c3 )

Definition at line 1460 of file i17lagm.F.

1462C-----------------------------------------------
1463C i=1,4
1464C ri=+-1 ti=+-1
1465C Ni = 1/4 (1+ro)(1+to)(ro+to-1)
1466C Ni = 1/4 (r^2 + ti r^2 t + t^2 + ri ti r t + ri r t^2 - 1)
1467C
1468C i=6;8
1469C ri=0 ti=+-1
1470C Ni = 1/2 ( 1 + ti t - r^2 - ti t r^2)
1471C
1472C
1473C i=5;7
1474C ri=+-1 ti=0
1475C Ni = 1/2 (1 + ri r - t^2 - ri r t^2)
1476C-----------------------------------------------
1477C f = Somme( fi Ni )
1478C
1479C f = A1 + A2 r + A3 t + A4 rt + A5 r^2 + A6 t^2 + A7 tr^2 + A8 rt^2
1480C f = (A1 + A3 t + A6 t^2) + (A2 + A4 t + A8 t^2)r + (A5 + A7 t)r^2
1481C f = B1 + B2 r + B3 r^2
1482C f = (A1 + A2 r + A5 r^2) + (A3 + A4 r + A7 r^2)t + (A6 + A8 r)t^2
1483C f = C1 + C2 t + C3 t^2
1484C
1485C A1 = (-f1 - f2 - f3 - f4 + 2 f5 + 2 f6 + 2 f7 + 2 f8)/4
1486C A2 = ( - f5 + f7 )/2
1487C A3 = ( + f6 - f8)/2
1488C A4 = (+f1 - f2 + f3 - f4 )/4
1489C A5 = (+f1 + f2 + f3 + f4 - 2 f6 - 2 f8)/4
1490C A6 = (+f1 + f2 + f3 + f4 - 2 f5 - 2 f7 )/4
1491C A7 = (-f1 + f2 + f3 - f4 - 2 f6 + 2 f8)/4
1492C A8 = (-f1 - f2 + f3 + f4 + 2 f5 - 2 f7 )/4
1493C-----------------------------------------------
1494C I m p l i c i t T y p e s
1495C-----------------------------------------------
1496#include "implicit_f.inc"
1497C-----------------------------------------------
1498C G l o b a l P a r a m e t e r s
1499C-----------------------------------------------
1500#include "mvsiz_p.inc"
1501C-----------------------------------------------
1502C D u m m y A r g u m e n t s
1503C-----------------------------------------------
1504 INTEGER LLT
1505 my_real
1506 + f(mvsiz,*),r(mvsiz),t(mvsiz),
1507 + b1(mvsiz),b2(mvsiz),b3(mvsiz),
1508 + c1(mvsiz),c2(mvsiz),c3(mvsiz)
1509C-----------------------------------------------
1510C L o c a l V a r i a b l e s
1511C-----------------------------------------------
1512 INTEGER I
1513 my_real
1514 + a1,a2,a3,a4,a5,a6,a7,a8,r2,t2,ff5,ff6,ff7,ff8
1515C
1516 DO i=1,llt
1517 ff5 = f(i,5) + f(i,5)
1518 ff6 = f(i,6) + f(i,6)
1519 ff7 = f(i,7) + f(i,7)
1520 ff8 = f(i,8) + f(i,8)
1521c
1522c A1 = (-F(I,1)-F(I,2)-F(I,3)-F(I,4)+FF5+FF6+FF7+FF8)*0.25 ...
1523c B1(I) = A1 + ( A3 + A6 * T(I) ) *T(I) ...
1524c
1525 a1 = (-f(i,1)-f(i,2)-f(i,3)-f(i,4)+ff5+ff6+ff7+ff8)
1526 a2 = ( -ff5 +ff7 )
1527 a3 = ( +ff6 -ff8)
1528 a4 = (+f(i,1)-f(i,2)+f(i,3)-f(i,4) )
1529 a5 = (+f(i,1)+f(i,2)+f(i,3)+f(i,4) -ff6 -ff8)
1530 a6 = (+f(i,1)+f(i,2)+f(i,3)+f(i,4)-ff5 -ff7 )
1531 a7 = (-f(i,1)+f(i,2)+f(i,3)-f(i,4) -ff6 +ff8)
1532 a8 = (-f(i,1)-f(i,2)+f(i,3)+f(i,4)+ff5 -ff7 )
1533c
1534c
1535 b1(i) = ( a1 + ( a3 + a6 * t(i) ) *t(i) )*fourth
1536 b2(i) = ( a2 + ( a4 + a8 * t(i) ) *t(i) )*fourth
1537 b3(i) = ( a5 + a7 * t(i) )*fourth
1538c
1539 c1(i) = ( a1 + ( a2 + a5 * r(i) ) *r(i) )*fourth
1540 c2(i) = ( a3 + ( a4 + a7 * r(i) ) *r(i) )*fourth
1541 c3(i) = ( a6 + a8 * r(i) )*fourth
1542 ENDDO
1543c
1544 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ i17borne()

subroutine i17borne ( integer llt,
r_s,
a,
b,
c,
integer, dimension(mvsiz) icont,
rs )

Definition at line 1384 of file i17lagm.F.

1385C-----------------------------------------------
1386C I m p l i c i t T y p e s
1387C-----------------------------------------------
1388#include "implicit_f.inc"
1389C-----------------------------------------------
1390C G l o b a l P a r a m e t e r s
1391C-----------------------------------------------
1392#include "mvsiz_p.inc"
1393C-----------------------------------------------
1394C D u m m y A r g u m e n t s
1395C-----------------------------------------------
1396 INTEGER LLT,ICONT(MVSIZ)
1397 my_real
1398 + r_s(mvsiz),c(mvsiz),b(mvsiz),a(mvsiz),rs(mvsiz)
1399C-----------------------------------------------
1400C L o c a l V a r i a b l e s
1401C-----------------------------------------------
1402 INTEGER I
1403 my_real
1404 + cc(mvsiz),r1(mvsiz),r2(mvsiz),rs1,rs2
1405c-----------------------------------------------------------------------
1406c 1: bound r (or s on the 2nd call) at +-1 on the main
1407c-----------------------------------------------------------------------
1408c-----------------------------------------------------------------------
1409c 1.1: bound <r1,t> and <r,t1> at +-1 on the main
1410c-----------------------------------------------------------------------
1411 DO i=1,llt
1412 rs(i) = c(i) + ( b(i) + a(i)*r_s(i) )*r_s(i)
1413 IF(rs(i)>one)THEN
1414 cc(i) = c(i) - one
1415 ELSEIF(rs(i)<-one)THEN
1416 cc(i) = c(i) + one
1417 ELSE
1418 cc(i) = one
1419 ENDIF
1420 ENDDO
1421c
1422C f = C + B r + A r^2
1423c
1424 CALL i17racine(llt,a,b,cc,r1,r2)
1425c
1426 DO i=1,llt
1427 IF(rs(i)>one.OR.rs(i)<-one)THEN
1428 rs1 = c(i) + ( b(i) + a(i)*r1(i) )*r1(i)
1429 rs2 = c(i) + ( b(i) + a(i)*r2(i) )*r2(i)
1430 IF(rs1>=-one.AND.rs1<=one.AND.
1431 + rs2>=-one.AND.rs2<=one)THEN
1432 IF(abs(rs(i)-r1(i))<abs(rs(i)-r2(i)))THEN
1433 r_s(i) = r1(i)
1434 rs(i) = rs1
1435 ELSE
1436 r_s(i) = r2(i)
1437 rs(i) = rs2
1438 ENDIF
1439 ELSEIF(rs1>=-one.AND.rs1<=one)THEN
1440 r_s(i) = r1(i)
1441 rs(i) = rs1
1442 ELSEIF(rs2>=-one.AND.rs2<=one)THEN
1443 r_s(i) = r2(i)
1444 rs(i) = rs2
1445 ELSE
1446C No main/second cover
1447 icont(i)=0
1448 ENDIF
1449 ENDIF
1450 ENDDO
1451c
1452 RETURN
i17racine
subroutine i17racine(llt, a, b, c, r1, r2)
Definition i17lagm.F:1319

◆ i17lagm()

subroutine i17lagm ( x,
v,
integer, dimension(*) lll,
integer, dimension(*) jll,
integer, dimension(*) sll,
xll,
integer, dimension(*) candn,
integer, dimension(*) cande,
integer i_stok,
integer, dimension(nixs,*) ixs,
integer, dimension(8,*) ixs16,
integer, dimension(*) iadll,
eminx,
integer, dimension(*) neles,
integer, dimension(*) nelem,
integer nc,
integer n_mul_mx,
integer itask,
a,
integer itied,
integer nint,
integer nkmax,
eminxs,
integer, dimension(*) comntag )

Definition at line 33 of file i17lagm.F.

38 use element_mod , only : nixs
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "task_c.inc"
51#include "com04_c.inc"
52#include "com08_c.inc"
53 COMMON /i17globi/ie_min,ies_min
54 COMMON /i17globr/vit_min
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER NC,I_STOK,N_MUL_MX,ITASK,ITIED,NINT,NKMAX ,
59 . LLL(*),JLL(*),SLL(*),CANDN(*),CANDE(*),COMNTAG(*),
60 . IXS(NIXS,*),IXS16(8,*),IADLL(*),NELES(*) ,NELEM(*)
61C REAL
62 my_real
63 . x(3,*),v(3,*),xll(*),
64 . eminx(6,*),eminxs(6,*),a(3,*)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I,J,K,IK,IE,IS,IC,NK,III(MVSIZ,17),LLT,NFT,LE,FIRST,LAST,
69 . I16,LES,IES,IIIS(MVSIZ,16),NC_SAV,IEL(MVSIZ),IESL(MVSIZ),
70 . IE_MIN,IES_MIN
71 my_real
72 . xx(mvsiz,17),yy(mvsiz,17),zz(mvsiz,17),
73 . xxs(mvsiz,16),yys(mvsiz,16),zzs(mvsiz,16),
74 . aa,xmin,ymin,zmin,xmax,ymax,zmax,dist,vit_min
75C-----------------------------------------------
76C
77C
78C | M | Lt| | a | M ao
79C |---+---| | = |
80C | L | 0 | | la | bo
81C
82C [M] a + [L]t la = [M] ao
83C [L] a = bo
84C
85C a = -[M]-1[L]t la + ao
86C [L][M]-1[L]t la = [L] ao - bo
87C
88C on pose:
89C [H] = [L][M]-1[L]t
90C b = [L] ao - bo
91C
92C [H] la = b
93C
94C a = ao - [M]-1[L]t la
95C-----------------------------------------------
96C
97C la : LAMBDA(NC)
98C ao : A(NUMNOD)
99C L : XLL(NK,NC)
100C M : MAS(NUMNOD)
101C [L][M]-1[L]t la : HLA(NC)
102C [L] ao - b : B(NC)
103C [M]-1[L]t la : LTLA(NUMNOD)
104C
105C NC : number of contacts
106C NK: Number of node for contact (8+1.16+1.8+8.16+16)
107C
108C IC : contact number (1,NC)
109C IK : local node number for a contact (1,NK)
110C I : global node number (1,NUMNOD)
111C
112C IADLL(NC) : IAD = IADLL(IC)
113C LLL(NC*(17,51)) : I = LLL(IAD+1,2...IADNEXT-1)
114C-----------------------------------------------
115C evaluation of b:
116C
117C Vs = Somme(Ni Vi)
118C Vs_ + dt As = Somme(Ni Vi_) + Somme(dt Ni Ai)
119C Somme(dt Ni Ai) - dt As = Vs_ -Somme(Ni Vi_)
120C [L] = dt {N1,N2,..,N15,-1}
121C bo = [L] a = -[L]/dt v_
122C b = [L] ao - bo
123C b = [L] ao + [L]/dt v_ = [L] (v_ + ao dt)/dt
124C-----------------------------------------------
125C b = [L] vo+/dt + vout
126C-----------------------------------------------
127C-----------------------------------------------------------------------
128C loop over contact candidates
129C-----------------------------------------------------------------------
130 nc_sav = nc
131 vit_min = zero
132 ie_min = 99999999
133 ies_min = 99999999
134 CALL my_barrier
135 first = 1 + i_stok * itask / nthread
136 last = i_stok*(itask+1) / nthread
137 llt = 0
138 nft=llt+1
139 DO ic=first,last
140 le = cande(ic)
141 les = candn(ic)
142 ie = nelem(le)
143 ies = neles(les)
144C-----------------------------------------------------------------------
145C test if inside the box
146C-----------------------------------------------------------------------
147 IF(le >0.AND.les>0.AND.
148 . eminxs(4,les)>eminx(1,le).AND.
149 . eminxs(5,les)>eminx(2,le).AND.
150 . eminxs(6,les)>eminx(3,le).AND.
151 . eminxs(1,les)<eminx(4,le).AND.
152 . eminxs(2,les)<eminx(5,le).AND.
153 . eminxs(3,les)<eminx(6,le))THEN
154c
155c print *, "in la boite",XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX
156c
157 llt = llt+1
158 iel(llt)=ie
159 iesl(llt)=ies
160 DO k=1,4
161C III 1,2,3,4,5,6,7,8, 9,10,11,12,13,14,15,16
162 iii(llt,k) =ixs(k+1,ie)
163 iii(llt,k+4) =ixs(k+5,ie)
164 iii(llt,k+8) =ixs16(k,ie-numels8-numels10-numels20)
165 iii(llt,k+12)=ixs16(k+4,ie-numels8-numels10-numels20)
166C IIIS 1,2,3,4,9,10,11,12, 5,6,7,8,13,14,15,16
167 iiis(llt,k) =ixs(k+1,ies)
168 iiis(llt,k+8) =ixs(k+5,ies)
169 iiis(llt,k+4)=ixs16(k,ies-numels8-numels10-numels20)
170 iiis(llt,k+12)=ixs16(k+4,ies-numels8-numels10-numels20)
171 ENDDO
172 DO k=1,16
173 i = iii(llt,k)
174c XX(LLT,K)=X(1,I)+DT2*(V(1,I)+DT12*A(1,I))
175c YY(LLT,K)=X(2,I)+DT2*(V(2,I)+DT12*A(2,I))
176c ZZ(LLT,K)=X(3,I)+DT2*(V(3,I)+DT12*A(3,I))
177c XX(LLT,K)=X(1,I)
178c YY(LLT,K)=X(2,I)
179c ZZ(LLT,K)=X(3,I)
180 xx(llt,k)=x(1,i)+half*dt2*(v(1,i)+dt12*a(1,i))
181 yy(llt,k)=x(2,i)+half*dt2*(v(2,i)+dt12*a(2,i))
182 zz(llt,k)=x(3,i)+half*dt2*(v(3,i)+dt12*a(3,i))
183 i = iiis(llt,k)
184 xxs(llt,k)=x(1,i)+half*dt2*(v(1,i)+dt12*a(1,i))
185 yys(llt,k)=x(2,i)+half*dt2*(v(2,i)+dt12*a(2,i))
186 zzs(llt,k)=x(3,i)+half*dt2*(v(3,i)+dt12*a(3,i))
187 ENDDO
188c
189c print *, "XX(1,1),XX(1,9)",XX(1,1),XX(1,9)
190c
191C-----------------------------------------------------------------------
192C calculation of [L] by mvsiz packet
193C-----------------------------------------------------------------------
194 IF(llt==mvsiz-1)THEN
195 CALL i17lll(
196 1 llt ,lll ,jll ,sll ,xll ,v ,
197 2 xx ,yy ,zz ,iii ,nc ,iadll ,
198 3 n_mul_mx ,a ,x ,itied ,nint ,nkmax ,
199 4 xxs ,yys ,zzs ,iiis ,nc_sav ,vit_min ,
200 5 iel ,iesl ,ie_min ,ies_min ,itask ,comntag )
201 nft=llt+1
202 llt = 0
203 ENDIF
204 ELSE
205c debug
206 k=0
207 ENDIF
208 ENDDO
209C-----------------------------------------------------------------------
210C calculation of [L] for last packet
211C-----------------------------------------------------------------------
212 IF(llt/=0) CALL i17lll(
213 1 llt ,lll ,jll ,sll ,xll ,v ,
214 2 xx ,yy ,zz ,iii ,nc ,iadll ,
215 3 n_mul_mx ,a ,x ,itied ,nint ,nkmax ,
216 4 xxs ,yys ,zzs ,iiis ,nc_sav ,vit_min ,
217 5 iel ,iesl ,ie_min ,ies_min ,itask ,comntag )
218C
219C-----------------------------------------------
220 CALL my_barrier
221 RETURN
i17lll
subroutine i17lll(llt, lll, jll, sll, xll, v, xx, yy, zz, iii, nc, iadll, n_mul_mx, a, x, itied, nint, nkmax, xxs, yys, zzs, iiis, nc_sav, vit_min, ie, ies, ie_min, ies_min, itask, comntag)
Definition i17lagm.F:238
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
my_barrier
subroutine my_barrier
Definition machine.F:31

◆ i17lll()

subroutine i17lll ( integer llt,
integer, dimension(*) lll,
integer, dimension(*) jll,
integer, dimension(*) sll,
xll,
v,
xx,
yy,
zz,
integer, dimension(mvsiz,17) iii,
integer nc,
integer, dimension(*) iadll,
integer n_mul_mx,
a,
x,
integer itied,
integer nint,
integer nkmax,
xxs,
yys,
zzs,
integer, dimension(mvsiz,16) iiis,
integer nc_sav,
vit_min,
integer, dimension(*) ie,
integer, dimension(*) ies,
integer ie_min,
integer ies_min,
integer itask,
integer, dimension(*) comntag )

Definition at line 233 of file i17lagm.F.

238C-----------------------------------------------
239C I m p l i c i t T y p e s
240C-----------------------------------------------
241#include "implicit_f.inc"
242Cbbdebug +1
243#include "comlock.inc"
244C-----------------------------------------------
245C G l o b a l P a r a m e t e r s
246C-----------------------------------------------
247#include "mvsiz_p.inc"
248C-----------------------------------------------
249C D u m m y A r g u m e n t s
250C-----------------------------------------------
251 INTEGER LLT,NC,N_MUL_MX,ITIED,NINT ,NKMAX ,NC_SAV ,IE_MIN,IES_MIN
252 INTEGER LLL(*),JLL(*),SLL(*),ITASK,COMNTAG(*),
253 . III(MVSIZ,17),IADLL(*) ,IIIS(MVSIZ,16),IE(*) ,IES(*)
254C REAL
255 my_real
256 . xll(*),v(3,*),a(3,*)
257 my_real
258 . xx(mvsiz,17),yy(mvsiz,17),zz(mvsiz,17),x(3,*),
259 . xxs(mvsiz,16) ,yys(mvsiz,16) ,zzs(mvsiz,16) ,vit_min
260C-----------------------------------------------
261C L o c a l V a r i a b l e s
262C-----------------------------------------------
263 INTEGER I,J,IK,NK,I1,I2,I3,I4,IAD,ICON,
264 + ICONT(MVSIZ,4)
265 my_real
266 . vx,vy,vz,vn,aa,vv,pene
267 my_real
268 . r_cm(mvsiz),t_cm(mvsiz),s_cm(mvsiz),si_s(mvsiz,8),
269 . ri_s(mvsiz,8),ti_s(mvsiz,8),
270 . nx(mvsiz), ny(mvsiz), nz(mvsiz),
271 . ni_m(mvsiz,17),ni_s(mvsiz,8) ,
272 . r_1s(mvsiz) ,r_2s(mvsiz) ,t_1s(mvsiz) ,t_2s(mvsiz),
273 . r_1m(mvsiz) ,r_2m(mvsiz) ,t_1m(mvsiz) ,t_2m(mvsiz),
274 . r_3m(mvsiz) ,r_4m(mvsiz) ,t_3m(mvsiz) ,t_4m(mvsiz),
275 . r_cs(mvsiz) ,s_cs(mvsiz) ,t_cs(mvsiz) ,vit(mvsiz),
276 . r_s(mvsiz) ,t_s(mvsiz)
277C-----------------------------------------------
278C calculation de r,s,t
279C-----------------------------------------------
280c
281c print *, "XX(1,1),XX(1,9)",XX(1,1),XX(1,9)
282c
283C-----------------------------------------------
284C central node face 1 2 3 4
285C-----------------------------------------------
286 DO i=1,llt
287 xx(i,17) = half *(xxs(i,5) +xxs(i,6) +xxs(i,7) +xxs(i,8))
288 . - fourth*(xxs(i,1) +xxs(i,2) +xxs(i,3) +xxs(i,4))
289 yy(i,17) = half *(yys(i,5) +yys(i,6) +yys(i,7) +yys(i,8))
290 . - fourth*(yys(i,1) +yys(i,2) +yys(i,3) +yys(i,4))
291 zz(i,17) = half *(zzs(i,5) +zzs(i,6) +zzs(i,7) +zzs(i,8))
292 . - fourth*(zzs(i,1) +zzs(i,2) +zzs(i,3) +zzs(i,4))
293 ENDDO
294 CALL i17rst(llt ,ri_s(1,1),si_s(1,1),ti_s(1,1),ni_m ,
295 2 xx ,yy ,zz )
296C-----------------------------------------------
297C Central node face 5 6 7 8
298C-----------------------------------------------
299 DO i=1,llt
300 xx(i,17) = half *(xxs(i,13)+xxs(i,14)+xxs(i,15)+xxs(i,16))
301 . - fourth*(xxs(i,9) +xxs(i,10)+xxs(i,11)+xxs(i,12))
302 yy(i,17) = half *(yys(i,13)+yys(i,14)+yys(i,15)+yys(i,16))
303 . - fourth*(yys(i,9) +yys(i,10)+yys(i,11)+yys(i,12))
304 zz(i,17) = half *(zzs(i,13)+zzs(i,14)+zzs(i,15)+zzs(i,16))
305 . - fourth*(zzs(i,9) +zzs(i,10)+zzs(i,11)+zzs(i,12))
306 ENDDO
307 CALL i17rst(llt ,ri_s(1,2),si_s(1,2),ti_s(1,2),ni_m ,
308 2 xx ,yy ,zz )
309C-----------------------------------------------
310C choix face 1 2 3 4 face 5 6 7 8 cote second
311C-----------------------------------------------
312 DO i=1,llt
313 IF(abs(si_s(i,1))<=abs(si_s(i,2)))THEN
314C face 1 2 3 4
315 s_cs(i) = -one
316 ELSE
317C face 5 6 7 8
318 s_cs(i) = one
319 iiis(i,1) = iiis(i,9)
320 iiis(i,2) = iiis(i,10)
321 iiis(i,3) = iiis(i,11)
322 iiis(i,4) = iiis(i,12)
323 iiis(i,5) = iiis(i,13)
324 iiis(i,6) = iiis(i,14)
325 iiis(i,7) = iiis(i,15)
326 iiis(i,8) = iiis(i,16)
327C
328 xxs(i,1) = xxs(i,9)
329 xxs(i,2) = xxs(i,10)
330 xxs(i,3) = xxs(i,11)
331 xxs(i,4) = xxs(i,12)
332 xxs(i,5) = xxs(i,13)
333 xxs(i,6) = xxs(i,14)
334 xxs(i,7) = xxs(i,15)
335 xxs(i,8) = xxs(i,16)
336C
337 yys(i,1) = yys(i,9)
338 yys(i,2) = yys(i,10)
339 yys(i,3) = yys(i,11)
340 yys(i,4) = yys(i,12)
341 yys(i,5) = yys(i,13)
342 yys(i,6) = yys(i,14)
343 yys(i,7) = yys(i,15)
344 yys(i,8) = yys(i,16)
345C
346 zzs(i,1) = zzs(i,9)
347 zzs(i,2) = zzs(i,10)
348 zzs(i,3) = zzs(i,11)
349 zzs(i,4) = zzs(i,12)
350 zzs(i,5) = zzs(i,13)
351 zzs(i,6) = zzs(i,14)
352 zzs(i,7) = zzs(i,15)
353 zzs(i,8) = zzs(i,16)
354C
355 ENDIF
356 ENDDO
357C-----------------------------------------------
358C calculation de SI_S=s(relatif element main)
359c the 8 nodes of the face of the second element
360C-----------------------------------------------
361 DO j=1,8
362 DO i=1,llt
363 xx(i,17) = xxs(i,j)
364 yy(i,17) = yys(i,j)
365 zz(i,17) = zzs(i,j)
366 ENDDO
367 CALL i17rst(llt ,ri_s(1,j),si_s(1,j),ti_s(1,j),ni_m ,
368 2 xx ,yy ,zz )
369 ENDDO
370C-----------------------------------------------
371C calculation of the minimum distance point
372C dSI_S/dr = 0 dSI_S/dt = 0 (r,t de l'element second)
373C-----------------------------------------------
374 CALL i17mini(llt ,r_cs ,s_cs ,t_cs ,ri_s ,si_s ,
375 2 ti_s ,ni_s ,xxs ,yys ,zzs ,xx ,
376 3 yy ,zz ,r_cm ,s_cm ,t_cm ,nx ,
377 4 ny ,nz ,r_1s ,r_2s ,t_1s ,t_2s ,
378 5 r_1m ,r_2m ,r_3m ,r_4m ,t_1m ,t_2m ,
379 6 t_3m ,t_4m ,icont )
380C-----------------------------------------------
381C Choice Facing 1 2 3 4 Face 5 6 7 8 main side
382C-----------------------------------------------
383 DO i=1,llt
384 IF(s_cm(i)<=0.)THEN
385C face 1 2 3 4
386 iii(i,5) = iii(i,9)
387 iii(i,6) = iii(i,10)
388 iii(i,7) = iii(i,11)
389 iii(i,8) = iii(i,12)
390 ELSE
391C face 5 6 7 8
392 iii(i,1) = iii(i,5)
393 iii(i,2) = iii(i,6)
394 iii(i,3) = iii(i,7)
395 iii(i,4) = iii(i,8)
396 iii(i,5) = iii(i,13)
397 iii(i,6) = iii(i,14)
398 iii(i,7) = iii(i,15)
399 iii(i,8) = iii(i,16)
400 ENDIF
401 ENDDO
402C-----------------------------------------------------------------------
403C calculation of penetration velocities
404C-----------------------------------------------------------------------
405 DO i=1,llt
406 vit(i) = em20
407 ENDDO
408 CALL i17vit4(llt ,nint ,v ,a ,iii ,iiis ,
409 2 ni_m ,ni_s ,nx ,ny ,nz ,vit ,
410 3 icont(1,1),r_1m ,t_1m ,r_1s ,t_cs ,s_cs ,
411 4 r_cm ,t_cm ,r_s ,t_s ,icont(1,1))
412 CALL i17vit4(llt ,nint ,v ,a ,iii ,iiis ,
413 2 ni_m ,ni_s ,nx ,ny ,nz ,vit ,
414 3 icont(1,2),r_2m ,t_2m ,r_2s ,t_cs ,s_cs ,
415 4 r_cm ,t_cm ,r_s ,t_s ,icont(1,1))
416 CALL i17vit4(llt ,nint ,v ,a ,iii ,iiis ,
417 2 ni_m ,ni_s ,nx ,ny ,nz ,vit ,
418 3 icont(1,3),r_3m ,t_3m ,r_cs ,t_1s ,s_cs ,
419 4 r_cm ,t_cm ,r_s ,t_s ,icont(1,1))
420 CALL i17vit4(llt ,nint ,v ,a ,iii ,iiis ,
421 2 ni_m ,ni_s ,nx ,ny ,nz ,vit ,
422 3 icont(1,4),r_4m ,t_4m ,r_cs ,t_2s ,s_cs ,
423 4 r_cm ,t_cm ,r_s ,t_s ,icont(1,1))
424c tmp !!!!!!!!!!!!!!!!!!!!!!!!!!! single contact
425c VV = 0.
426c DO I=1,LLT
427c VV = MIN(VV,VIT(I))
428c ENDDO
429c DO I=1,LLT
430c IF(VV==VIT(I))THEN
431c VV=1.
432c ELSE
433c ICONT(I,1)=0
434c ENDIF
435c ENDDO
436c tmp !!!!!!!!!!!!!!!!!!!!!!!!!!!
437c DO I=1,LLT
438c PENE = 1. - ABS(S_CM(I))
439c IF(ICONT(I,1)==1.AND.PENE>PENE_MAX)THEN
440c PENE_MAX = PENE
441c NC = NC_SAV
442c J = I
443c ENDIF
444c ICONT(I,1) = 0
445c ENDDO
446c ICONT(J,1) = 1
447#include "lockon.inc"
448 j=0
449 DO i=1,llt
450 IF(vit(i)<vit_min.OR.
451 . (vit(i)==vit_min.AND.
452 . (ie(i)<ie_min.OR.
453 . (ie(i)==ie_min.AND.ies(i)<ies_min))))THEN
454 vit_min = vit(i)
455 ie_min = ie(i)
456 ies_min = ies(i)
457 nc = nc_sav
458 j = i
459 icon=icont(i,1)
460 ENDIF
461 icont(i,1) = 0
462 ENDDO
463 IF(j/=0)THEN
464 icont(j,1) = icon
465cc print *,ITASK,':',VIT(J),IE(J),IES(J),NC,J,ICON
466 ENDIF
467C-----------------------------------------------------------------------
468C contact calculation
469C-----------------------------------------------------------------------
470 CALL i17lll4(llt ,lll ,jll ,sll ,xll ,n_mul_mx,
471 2 itied ,nint ,nkmax ,nc ,v ,a ,
472 3 iadll ,iii ,iiis ,ni_m ,ni_s ,
473 4 nx ,ny ,nz ,vit ,comntag,
474 5 icont(1,1),r_cm ,t_cm ,r_s ,t_s )
475c IF(J/=0)THEN
476c do i=1,nc*16
477c print *,ITASK,':',i,':',LLL(i),JLL(i),XLL(i)
478c enddo
479c ENDIF
480C
481#include "lockoff.inc"
482 RETURN
i17lll4
subroutine i17lll4(llt, lll, jll, sll, xll, n_mul_mx, itied, nint, nkmax, nc, v, a, iadll, iii, iiis, ni_m, ni_s, nx, ny, nz, vit, comntag, icont, rm, tm, rs, ts)
Definition i17lagm.F:602
i17vit4
subroutine i17vit4(llt, nint, v, a, iii, iiis, ni_m, ni_s, nx, ny, nz, vit, icont, rm, tm, rs, ts, sm, r_m, t_m, r_s, t_s, icontn)
Definition i17lagm.F:495
i17mini
subroutine i17mini(llt, r_cs, s_cs, t_cs, ri_s, si_s, ti_s, ni_s, xxs, yys, zzs, xx, yy, zz, r_cm, s_cm, t_cm, nx, ny, nz, r_1s, r_2s, t_1s, t_2s, r_1m, r_2m, r_3m, r_4m, t_1m, t_2m, t_3m, t_4m, icont)
Definition i17lagm.F:901
i17rst
subroutine i17rst(llt, r, s, t, ni, xx, yy, zz)
Definition i17lagm.F:775

◆ i17lll4()

subroutine i17lll4 ( integer llt,
integer, dimension(*) lll,
integer, dimension(*) jll,
integer, dimension(*) sll,
xll,
integer n_mul_mx,
integer itied,
integer nint,
integer nkmax,
integer nc,
v,
a,
integer, dimension(*) iadll,
integer, dimension(mvsiz,17) iii,
integer, dimension(mvsiz,16) iiis,
ni_m,
ni_s,
nx,
ny,
nz,
vit,
integer, dimension(*) comntag,
integer, dimension(mvsiz) icont,
rm,
tm,
rs,
ts )

Definition at line 597 of file i17lagm.F.

602C-----------------------------------------------
603C M o d u l e s
604C-----------------------------------------------
605 USE message_mod
606C-----------------------------------------------
607C I m p l i c i t T y p e s
608C-----------------------------------------------
609#include "implicit_f.inc"
610#include "comlock.inc"
611C-----------------------------------------------
612C G l o b a l P a r a m e t e r s
613C-----------------------------------------------
614#include "mvsiz_p.inc"
615C-----------------------------------------------
616C D u m m y A r g u m e n t s
617C-----------------------------------------------
618 INTEGER LLT,NC,N_MUL_MX,ITIED,NINT ,NKMAX
619 INTEGER LLL(*),JLL(*),SLL(*),COMNTAG(*),
620 . III(MVSIZ,17),IADLL(*) ,IIIS(MVSIZ,16),
621 + ICONT(MVSIZ)
622C REAL
623 my_real
624 . xll(*),v(3,*),a(3,*),vit(*)
625 my_real
626 . rm(mvsiz) ,rs(mvsiz) ,tm(mvsiz) ,ts(mvsiz) ,
627 . ni_m(mvsiz,*) ,ni_s(mvsiz,*),nx(mvsiz) ,ny(mvsiz) ,nz(mvsiz)
628C-----------------------------------------------
629C L o c a l V a r i a b l e s
630C-----------------------------------------------
631 INTEGER I,J,IK,NK,I1,I2,I3,I4,IAD,NN
632 my_real
633 . vx,vy,vz,vn,aa
634C-----------------------------------------------
635 IF(itied==0)THEN
636 DO i=1,llt
637C-----------------------------------------------
638C Test if contact
639C-----------------------------------------------
640 IF(icont(i)/=0)THEN
641C
642 nk = 16
643 nc=nc+1
644 IF(nc>n_mul_mx)THEN
645 CALL ancmsg(msgid=89,anmode=aninfo)
646 CALL arret(2)
647 ENDIF
648 iadll(nc+1)=iadll(nc) + 48
649 IF(iadll(nc+1)-1>nkmax)THEN
650 CALL ancmsg(msgid=89,anmode=aninfo)
651 CALL arret(2)
652 ENDIF
653 iad = iadll(nc) - 1
654 DO ik=1,8
655 lll(iad+ik) = iii(i,ik)
656 jll(iad+ik) = 1
657 sll(iad+ik) = 0
658 xll(iad+ik) = nx(i)*ni_m(i,ik)
659 lll(iad+ik+16) = iii(i,ik)
660 jll(iad+ik+16) = 2
661 sll(iad+ik+16) = 0
662 xll(iad+ik+16) = ny(i)*ni_m(i,ik)
663 lll(iad+ik+32) = iii(i,ik)
664 jll(iad+ik+32) = 3
665 sll(iad+ik+32) = 0
666 xll(iad+ik+32) = nz(i)*ni_m(i,ik)
667C
668 lll(iad+ik+8) = iiis(i,ik)
669 jll(iad+ik+8) = 1
670 sll(iad+ik+8) = nint
671 xll(iad+ik+8) = -nx(i)*ni_s(i,ik)
672 lll(iad+ik+24) = iiis(i,ik)
673 jll(iad+ik+24) = 2
674 sll(iad+ik+24) = nint
675 xll(iad+ik+24) = -ny(i)*ni_s(i,ik)
676 lll(iad+ik+40) = iiis(i,ik)
677 jll(iad+ik+40) = 3
678 sll(iad+ik+40) = nint
679 xll(iad+ik+40) = -nz(i)*ni_s(i,ik)
680 nn = lll(iad+ik)
681 comntag(nn) = comntag(nn) + 1
682 ENDDO
683c#include "lockoff.inc"
684 ENDIF
685 ENDDO
686 ELSEIF(itied==1)THEN
687C-----------------------------------------------
688C ITIED = 1
689C-----------------------------------------------
690 DO i=1,llt
691C-----------------------------------------------
692C Test if contact
693C-----------------------------------------------
694 IF(icont(i)/=0)THEN
695C
696 nk = 16
697 IF(nc+3>n_mul_mx)THEN
698 CALL ancmsg(msgid=89,anmode=aninfo)
699 CALL arret(2)
700 ENDIF
701 IF(iadll(nc+1)-1+16*3>nkmax)THEN
702 CALL ancmsg(msgid=89,anmode=aninfo)
703 CALL arret(2)
704 ENDIF
705C
706 nc=nc+1
707 iadll(nc+1)=iadll(nc) + 16
708 iad = iadll(nc) - 1
709 DO ik=1,8
710 lll(iad+ik) = iii(i,ik)
711 jll(iad+ik) = 1
712 sll(iad+ik) = 0
713 xll(iad+ik) = ni_m(i,ik)
714 lll(iad+ik+8) = iiis(i,ik)
715 jll(iad+ik+8) = 1
716 sll(iad+ik+8) = nint
717 xll(iad+ik+8) = -ni_s(i,ik)
718 nn = lll(iad+ik)
719 comntag(nn) = comntag(nn) + 1
720 ENDDO
721C
722 nc=nc+1
723 iadll(nc+1)=iadll(nc) + 16
724 iad = iadll(nc) - 1
725 DO ik=1,8
726 lll(iad+ik) = iii(i,ik)
727 jll(iad+ik) = 2
728 sll(iad+ik) = 0
729 xll(iad+ik) = ni_m(i,ik)
730 lll(iad+ik+8) = iiis(i,ik)
731 jll(iad+ik+8) = 2
732 sll(iad+ik+8) = nint
733 xll(iad+ik+8) = -ni_s(i,ik)
734 nn = lll(iad+ik)
735 comntag(nn) = comntag(nn) + 1
736 ENDDO
737C
738 nc=nc+1
739 iadll(nc+1)=iadll(nc) + 16
740 iad = iadll(nc) - 1
741 DO ik=1,8
742 lll(iad+ik) = iii(i,ik)
743 jll(iad+ik) = 3
744 sll(iad+ik) = 0
745 xll(iad+ik) = ni_m(i,ik)
746 lll(iad+ik+8) = iiis(i,ik)
747 jll(iad+ik+8) = 3
748 sll(iad+ik+8) = nint
749 xll(iad+ik+8) = -ni_s(i,ik)
750 nn = lll(iad+ik)
751 comntag(nn) = comntag(nn) + 1
752 ENDDO
753c#include "lockoff.inc"
754 ENDIF
755 ENDDO
756 ENDIF
757c
758c print *, "r,s,t",r(1),s(1),t(1)
759C
760 RETURN
message_mod
Definition message_mod.F:1257
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86

◆ i17mini()

subroutine i17mini ( integer llt,
r_cs,
s_cs,
t_cs,
ri_s,
si_s,
ti_s,
ni_s,
xxs,
yys,
zzs,
xx,
yy,
zz,
r_cm,
s_cm,
t_cm,
nx,
ny,
nz,
r_1s,
r_2s,
t_1s,
t_2s,
r_1m,
r_2m,
r_3m,
r_4m,
t_1m,
t_2m,
t_3m,
t_4m,
integer, dimension(mvsiz,4) icont )

Definition at line 895 of file i17lagm.F.

901C-----------------------------------------------
902C I m p l i c i t T y p e s
903C-----------------------------------------------
904#include "implicit_f.inc"
905C-----------------------------------------------
906C G l o b a l P a r a m e t e r s
907C-----------------------------------------------
908#include "mvsiz_p.inc"
909C-----------------------------------------------
910C D u m m y A r g u m e n t s
911C-----------------------------------------------
912 INTEGER LLT,
913 + ICONT(MVSIZ,4)
914C REAL
915 my_real
916 + si_s(mvsiz,*),ni_s(mvsiz,*),ri_s,ti_s ,
917 + xxs(mvsiz,*) ,yys(mvsiz,*) ,zzs(mvsiz,*) ,
918 + xx(mvsiz,*) ,yy(mvsiz,*) ,zz(mvsiz,*) ,
919 + r_cm(mvsiz) ,s_cm(mvsiz) ,t_cm(mvsiz),
920 + r_cs(mvsiz) ,s_cs(mvsiz) ,t_cs(mvsiz),
921 + r_1s(mvsiz) ,r_2s(mvsiz) ,t_1s(mvsiz) ,t_2s(mvsiz),
922 + r_1m(mvsiz) ,r_2m(mvsiz) ,t_1m(mvsiz) ,t_2m(mvsiz),
923 + r_3m(mvsiz) ,r_4m(mvsiz) ,t_3m(mvsiz) ,t_4m(mvsiz),
924 + nx(mvsiz) ,ny(mvsiz) ,nz(mvsiz)
925C-----------------------------------------------
926C L o c a l V a r i a b l e s
927C-----------------------------------------------
928 INTEGER I,ITER,NITERMAX
929 my_real
930 + a1(mvsiz),a2(mvsiz),a3(mvsiz),a4(mvsiz),a5(mvsiz),
931 + b1(mvsiz),b2(mvsiz),b3(mvsiz),b4(mvsiz),b5(mvsiz),
932 + c1(mvsiz),c2(mvsiz),c3(mvsiz),
933 + f1,f2,f3,f4,f5,f6,f7,f8,
934 + cc1,cc2,cc3,dd1,dd2,dd3,dd,d,
935 + a0,ab,ba,a4r,b4t,a5t,b5r,eps
936C-----------------------------------------------
937C ro = r ri to = t ti
938C
939C i=1,4
940C ri=+-1 ti=+-1
941C Ni = 1/4 (1+ro)(1+to)(ro+to-1)
942C Ni = 1/4 (r^2+r^2to+t^2+roto+rot^2-1)
943C Ni = 1/4 (r^2(1+to)+t^2(1+ro)+roto-1)
944C dNi/dr = ri/4 (1+to)(2ro+to)
945C dNi/dt = ti/4 (1+ro)(2to+ro)
946C dNi/dr = 1/4 (2 r + ri ti t + 2ti rt + ri t^2)
947C dNi/dt = 1/4 (2 t + ri ti r + 2ri rt + ti r^2)
948C
949C i=6;8
950C ri=0 ti=+-1
951C Ni = 1/2 (1-r^2)(1+to)
952C dNi/dr = -r (1+to)
953C dNi/dt = ti/2 (1-r^2)
954C dNi/dr = 1/4 (-4 r - 4ti r t)
955C dNi/dt = 1/4 (2ti - 2ti r^2 )
956C
957C
958C i=5;7
959C ri=+-1 ti=0
960C Ni = 1/2 (1-t^2)(1+ro)
961C dNi/dr = ri/2 (1-t^2)
962C dNi/dt = -t (1+ro)
963C dNi/dr = 1/4 (2ri - 2ri t^2 )
964C dNi/dt = 1/4 (-4 t - 4ri rt )
965C-----------------------------------------------
966C df/dr = Somme( fi dNi/dr )
967C df/dt = Somme( fi dNi/dt )
968C
969C df/dr = A1 + A2 r + A3 t + A4 rt + A5 t^2
970C df/dt = B1 + B2 r + B3 t + B4 rt + B5 r^2
971C
972C A1 = ( -f5 + f7 )/2
973C A2 = ( f1 + f2 + f3 + f4 - 2 f6 - 2 f8)/2
974C A3 = ( f1 - f2 + f3 - f4 )/4
975C A4 = (-f1 + f2 + f3 - f4 - 2 f6 + 2 f8)/2
976C A5 = (-f1 - f2 + f3 + f4 + 2 f5 - 2 f7 )/4
977C
978C B1 = ( f6 - f8)/2
979C B2 = ( f1 - f2 + f3 - f4 )/4
980C B3 = ( f1 + f2 + f3 + f4 - 2 f5 - 2 f7 )/2
981C B4 = (-f1 - f2 + f3 + f4 + 2 f5 - 2 f7 )/2
982C B5 = (-f1 + f2 + f3 - f4 - 2 f6 + 2 f8)/4
983C
984C df/dr = A1 + A2 r + A3 t + A4 rt + A5 t^2 = 0
985C df/dt = B1 + B2 r + B3 t + B4 rt + B5 r^2 = 0
986C r = -(A1 + A3 t + A5 t^2 ) / (A2 + A4 t)
987C t = -(B1 + B2 r + B5 r^2 ) / (B3 + B4 r)
988c
989c
990c r
991C ^
992c |
993C . |7
994C 4 O-----------------O-----------------O 3
995C | . | |
996C | . | |
997C | | C |
998C | . r+------+df/dt=0 |
999C | . | |df/dr=0 |
1000C | | | |
1001C | | | |
1002C | | | |6
1003C 8 0 +------+----------0----> t
1004C | t |
1005C | |
1006C | |
1007C | |
1008C | |
1009C | |
1010C | |
1011C |' |
1012C O-----------------O-----------------O
1013C 1 5 2
1014C
1015C-----------------------------------------------
1016C
1017c
1018c
1019 nitermax = 5
1020C
1021 DO i=1,llt
1022 d = si_s(i,1)*si_s(i,1)+si_s(i,2)*si_s(i,2)
1023 + + si_s(i,3)*si_s(i,3)+si_s(i,4)*si_s(i,4)
1024 + + si_s(i,5)*si_s(i,5)+si_s(i,6)*si_s(i,6)
1025 + + si_s(i,7)*si_s(i,7)+si_s(i,8)*si_s(i,8)
1026 d = 1./max(em20,sqrt(d))
1027 f1 = d * si_s(i,1)
1028 f2 = d * si_s(i,2)
1029 f3 = d * si_s(i,3)
1030 f4 = d * si_s(i,4)
1031 f5 = d * si_s(i,5)
1032 f6 = d * si_s(i,6)
1033 f7 = d * si_s(i,7)
1034 f8 = d * si_s(i,8)
1035 a0 = ( f1 + f2 + f3 + f4 )*half
1036 ab = f5 - f7
1037 ba = f6 - f8
1038C
1039 a1(i) = -ab * half
1040 a2(i) = a0 - f6 - f8
1041 a3(i) = ( f1 - f2 + f3 - f4 )*fourth
1042 a4(i) = (-f1 + f2 + f3 - f4 )*half - ba
1043 a5(i) = (-f1 - f2 + f3 + f4 )*fourth - a1(i)
1044C
1045 b1(i) = ba*half
1046 b2(i) = a3(i)
1047 b3(i) = a0 - f5 - f7
1048 b4(i) = (-f1 - f2 + f3 + f4 )*half + ab
1049 b5(i) = (-f1 + f2 + f3 - f4 )*fourth - b1(i)
1050c
1051 r_cs(i) = zero
1052 t_cs(i) = zero
1053 ENDDO
1054c------------------------------------------------
1055c Newton ITER: lineari_sation in r and t
1056c------------------------------------------------
1057C fr = df/dr = A1 + A2 r + A3 t + A4 t r + A5 t t = 0
1058C ft = df/dt = B1 + B2 r + B3 t + B4 r t + B5 r r = 0
1059c
1060C fr = fr_ + dfr/dr dr + dfr/dt dt
1061C ft = ft_ + dft/dr dr + dft/dt dt
1062c
1063C fr = fr_ + dfr/dr (r-r_) + dfr/dt (t-t_) = 0
1064C ft = ft_ + dft/dr (r-r_) + dft/dt (t-t_) = 0
1065c
1066C dfr/dr = A2 + A4 t_ = C2
1067C dfr/dt = A3 + A4 r_ + 2 A5 t_ = C3
1068C dft/dr = B2 + B4 t_ + 2 B5 r_ = D2
1069C dft/dt = B3 + B4 r_ = D3
1070c
1071c C1 = A1 - A4 r_ t_ - A5 t_^2
1072c C2 = A2 + A4 t_
1073c C3 = A3 + A4 r_ + 2 A5 t_
1074c
1075c D1 = B1 - B4 r_ t_ - B5 r_^2
1076c D2 = B2 + B4 t_ + 2 B5 r_
1077c D3 = B3 + B4 r_
1078c
1079C fr = C1 + C2 r + C3 t = 0
1080C ft = D1 + D2 r + D3 t = 0
1081c
1082C r = (C3 D1 - D3 C1) / (D3 C2 - C3 D2)
1083C t = (D2 C1 - C2 D1) / (D3 C2 - C3 D2)
1084c------------------------------------------------
1085 DO iter=1,nitermax
1086 DO i=1,llt
1087 a4r = a4(i) * r_cs(i)
1088 a5t = a5(i) * t_cs(i)
1089 b4t = b4(i) * t_cs(i)
1090 b5r = b5(i) * r_cs(i)
1091 cc1 = a1(i) -(a4r + a5t) * t_cs(i)
1092 cc2 = a2(i) + a4(i) * t_cs(i)
1093 cc3 = a3(i) + a4r + a5t + a5t
1094 dd1 = b1(i) -(b4t + b5r )* r_cs(i)
1095 dd2 = b2(i) + b4t + b5r + b5r
1096 dd3 = b3(i) + b4(i) * r_cs(i)
1097 d = dd3 * cc2 - cc3 * dd2
1098 IF(abs(d)<em20)THEN
1099 cc2 = cc2 + em10
1100 dd3 = dd3 + em10
1101 d = dd3 * cc2 - cc3 * dd2
1102 ENDIF
1103 r_cs(i) = (cc3 * dd1 - dd3 * cc1) / d
1104 t_cs(i) = (dd2 * cc1 - cc2 * dd1) / d
1105 r_cs(i) = max(-one,min(one,r_cs(i)))
1106 t_cs(i) = max(-one,min(one,t_cs(i)))
1107c dfdr = A1 + A2 * r + A3 * t + A4 * t * r + A5 * t * t
1108c dfdt = B1 + B2 * r + B3 * t + B4 * r * t + B5 * r * r
1109c print *,'it=',iter,' r=',r,' t=',t,' fr=',dfdr,' ft=',dfdt
1110 ENDDO
1111 ENDDO
1112C-----------------------------------------------------------------------
1113C calculation of 4 points of the iso S_M = +- 1
1114C
1115C second. main
1116C 1: <R_1S , T_CS> <R_1M , T_1M>
1117C 2: <R_2S , T_CS> <R_2M , T_2M>
1118C 3: <R_CS , T_1S> <R_3M , T_3M>
1119C 4: <R_CS , T_2S> <R_4M , T_4M>
1120C
1121C We limit R and you +- 1 on the second element.::
1122C -1 < R_1S < 1 et -1 < R_2S < 1
1123C -1 < T_1S < 1 et -1 < T_2S < 1
1124c
1125C We limit R and you +- 1 on the main element:
1126C -1 < R_M < 1 et -1 < T_M < 1
1127C-----------------------------------------------------------------------
1128 CALL i17abc(llt ,si_s,r_cs,t_cs,
1129 + b1 ,b2 ,b3 ,c1 ,c2 ,c3 )
1130C
1131 DO i=1,llt
1132 s_cm(i) = b1(i) + b2(i)*r_cs(i) + b3(i)*r_cs(i)*r_cs(i)
1133 ENDDO
1134c
1135 DO i=1,llt
1136 IF(s_cm(i)>zero)THEN
1137 b1(i) = b1(i) - one
1138 c1(i) = c1(i) - one
1139 ELSE
1140 b1(i) = b1(i) + one
1141 c1(i) = c1(i) + one
1142 ENDIF
1143 ENDDO
1144c
1145C f = B1 + B2 r + B3 r^2
1146c
1147 CALL i17racine(llt,b3,b2,b1,r_1s,r_2s)
1148
1149C f = C1 + C2 t + C3 t^2
1150C
1151 CALL i17racine(llt,c3,c2,c1,t_1s,t_2s)
1152c-----------------------------------------------------------------------
1153c bound r at +-1 on the main
1154c-----------------------------------------------------------------------
1155C
1156 CALL i17abc(llt ,ri_s,r_cs,t_cs,
1157 + b1 ,b2 ,b3 ,c1 ,c2 ,c3 )
1158C
1159 DO i=1,llt
1160 r_cm(i) = b1(i) + (b2(i) + b3(i)*r_cs(i))*r_cs(i)
1161 icont(i,1) = 1
1162 icont(i,2) = 1
1163 icont(i,3) = 1
1164 icont(i,4) = 1
1165 ENDDO
1166C
1167c CALL I17BORNE(LLT ,R_CS,B3 ,B2 ,B1 ,ICONT(1,1),R_CM)
1168c CALL I17BORNE(LLT ,T_CS,C3 ,C2 ,C1 ,ICONT(1,1),R_CM)
1169 CALL i17borne(llt ,r_1s,b3 ,b2 ,b1 ,icont(1,1),r_1m)
1170 CALL i17borne(llt ,r_2s,b3 ,b2 ,b1 ,icont(1,2),r_2m)
1171 CALL i17borne(llt ,t_1s,c3 ,c2 ,c1 ,icont(1,3),r_3m)
1172 CALL i17borne(llt ,t_2s,c3 ,c2 ,c1 ,icont(1,4),r_4m)
1173c-----------------------------------------------------------------------
1174c 2: bound t at +-1 on the main
1175c-----------------------------------------------------------------------
1176 CALL i17abc(llt ,ti_s,r_cs,t_cs,
1177 + b1 ,b2 ,b3 ,c1 ,c2 ,c3 )
1178C
1179 DO i=1,llt
1180 t_cm(i) = b1(i) + (b2(i) + b3(i)*r_cs(i))*r_cs(i)
1181 ENDDO
1182C
1183c CALL I17BORNE(LLT ,R_CS,B3 ,B2 ,B1 ,ICONT(1,1),T_CM)
1184c CALL I17BORNE(LLT ,T_CS,C3 ,C2 ,C1 ,ICONT(1,1),T_CM)
1185 CALL i17borne(llt ,r_1s,b3 ,b2 ,b1 ,icont(1,1),t_1m)
1186 CALL i17borne(llt ,r_2s,b3 ,b2 ,b1 ,icont(1,2),t_2m)
1187 CALL i17borne(llt ,t_1s,c3 ,c2 ,c1 ,icont(1,3),t_3m)
1188 CALL i17borne(llt ,t_2s,c3 ,c2 ,c1 ,icont(1,4),t_4m)
1189c-----------------------------------------------------------------------
1190c Test if contact
1191c-----------------------------------------------------------------------
1192 CALL i17abc(llt ,si_s,r_cs,t_cs,
1193 + b1 ,b2 ,b3 ,c1 ,c2 ,c3 )
1194 eps = em3
1195 DO i=1,llt
1196 d = b1(i) + (b2(i) + b3(i)*r_1s(i)) * r_1s(i)
1197 IF(d<-one-eps.OR.d>one+eps) icont(i,1)=0
1198 d = b1(i) + (b2(i) + b3(i)*r_2s(i)) * r_2s(i)
1199 IF(d<-one-eps.OR.d>one+eps) icont(i,2)=0
1200 d = c1(i) + (c2(i) + c3(i)*t_1s(i)) * t_1s(i)
1201 IF(d<-one-eps.OR.d>one+eps) icont(i,3)=0
1202 d = c1(i) + (c2(i) + c3(i)*t_2s(i)) * t_2s(i)
1203 IF(d<-one-eps.OR.d>one+eps) icont(i,4)=0
1204c R_CS(I) = ICONT(I,1)*R_1S(I) + ICONT(I,2)*R_2S(I) +
1205c + ICONT(I,3)*R_CS(I) + ICONT(I,4)*R_CS(I)
1206c T_CS(I) = ICONT(I,1)*T_CS(I) + ICONT(I,2)*T_CS(I) +
1207c + ICONT(I,3)*T_1S(I) + ICONT(I,4)*T_2S(I)
1208cc R_CM(I) = ICONT(I,1)*R_1M(I) + ICONT(I,2)*R_2M(I) +
1209cc + ICONT(I,3)*R_3M(I) + ICONT(I,4)*R_4M(I)
1210cc T_CM(I) = ICONT(I,1)*T_1M(I) + ICONT(I,2)*T_2M(I) +
1211cc + ICONT(I,3)*T_3S(I) + ICONT(I,4)*T_4S(I)
1212c ICONT(I,1) = ICONT(I,1) + ICONT(I,2) +
1213c + ICONT(I,3) + ICONT(I,4)
1214c IF(ICONT(I,1)/=0)THEN
1215c R_CS(I) = R_CS(I) / ICONT(I,1)
1216c T_CS(I) = T_CS(I) / ICONT(I,1)
1217c ICONT(I,1) = 1
1218c ENDIF
1219 ENDDO
1220C
1221 CALL i17abc(llt ,si_s,r_cs,t_cs,
1222 + b1 ,b2 ,b3 ,c1 ,c2 ,c3 )
1223 DO i=1,llt
1224 s_cm(i) = b1(i) + (b2(i) + b3(i)*r_cs(i))*r_cs(i)
1225 ENDDO
1226C
1227 CALL i17abc(llt ,ri_s,r_cs,t_cs,
1228 + b1 ,b2 ,b3 ,c1 ,c2 ,c3 )
1229 DO i=1,llt
1230 r_cm(i) = b1(i) + (b2(i) + b3(i)*r_cs(i))*r_cs(i)
1231 ENDDO
1232C
1233 CALL i17abc(llt ,ti_s,r_cs,t_cs,
1234 + b1 ,b2 ,b3 ,c1 ,c2 ,c3 )
1235 DO i=1,llt
1236 t_cm(i) = b1(i) + (b2(i) + b3(i)*r_cs(i))*r_cs(i)
1237 ENDDO
1238C-----------------------------------------------
1239C calculation de Ni(r,s,t); dNi/dr; dNi/dt; normale second(-n)
1240C-----------------------------------------------
1241 CALL i17norm(llt ,r_cs ,s_cs ,t_cs ,
1242 2 nx ,ny ,nz ,xxs ,yys ,zzs )
1243c-----------------------------------------------------------------------
1244c
1245c-----------------------------------------------------------------------
1246 RETURN
i17borne
subroutine i17borne(llt, r_s, a, b, c, icont, rs)
Definition i17lagm.F:1385
i17norm
subroutine i17norm(llt, rr, ss, tt, nx, ny, nz, xx, yy, zz)
Definition i17lagm.F:1554
i17abc
subroutine i17abc(llt, f, r, t, b1, b2, b3, c1, c2, c3)
Definition i17lagm.F:1462
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ i17ni()

subroutine i17ni ( integer llt,
r,
t,
ni )

Definition at line 1254 of file i17lagm.F.

1255C-----------------------------------------------
1256C I m p l i c i t T y p e s
1257C-----------------------------------------------
1258#include "implicit_f.inc"
1259C-----------------------------------------------
1260C G l o b a l P a r a m e t e r s
1261C-----------------------------------------------
1262#include "mvsiz_p.inc"
1263C-----------------------------------------------
1264C D u m m y A r g u m e n t s
1265C-----------------------------------------------
1266 INTEGER LLT
1267 my_real
1268 . r(mvsiz),t(mvsiz),ni(mvsiz,*)
1269C-----------------------------------------------
1270C L o c a l V a r i a b l e s
1271C-----------------------------------------------
1272 INTEGER I
1273 my_real
1274 . u_m_r,u_p_r,u_m_s,u_p_s,u_m_t,u_p_t,
1275 . ums_umt,ums_upt,ups_umt,ups_upt,
1276 . umr_ums,umr_ups,upr_ums,upr_ups,
1277 . umt_umr,umt_upr,upt_umr,upt_upr,
1278 . a,r05,s05,t05
1279C-----------------------------------------------------------------------
1280C calculation of Ni
1281C-----------------------------------------------------------------------
1282 DO i=1,llt
1283C
1284C
1285 r05 = half*r(i)
1286 t05 = half*t(i)
1287C
1288 u_m_r = half - r05
1289 u_p_r = half + r05
1290C
1291 u_m_t = half - t05
1292 u_p_t = half + t05
1293C
1294 ni(i,1) = u_m_t * u_m_r * (-r(i)-t(i)-one)
1295 ni(i,2) = u_p_t * u_m_r * (-r(i)+t(i)-one)
1296 ni(i,3) = u_p_t * u_p_r * ( r(i)+t(i)-one)
1297 ni(i,4) = u_m_t * u_p_r * ( r(i)-t(i)-one)
1298C------------------------------------
1299 a = (one-r(i)*r(i))
1300 ni(i,6) = a * u_p_t
1301 ni(i,8) = a * u_m_t
1302C------------------------------------
1303 a = (one-t(i)*t(i))
1304 ni(i,5) = a * u_m_r
1305 ni(i,7) = a * u_p_r
1306C------------------------------------
1307 ENDDO
1308C-----------------------------------------------
1309 RETURN

◆ i17norm()

subroutine i17norm ( integer llt,
rr,
ss,
tt,
nx,
ny,
nz,
xx,
yy,
zz )

Definition at line 1552 of file i17lagm.F.

1554C-----------------------------------------------
1555C calculation de Ni(r,t); dNi/dr; dNi/dt; normale
1556C-----------------------------------------------
1557C I m p l i c i t T y p e s
1558C-----------------------------------------------
1559#include "implicit_f.inc"
1560C-----------------------------------------------
1561C G l o b a l P a r a m e t e r s
1562C-----------------------------------------------
1563#include "mvsiz_p.inc"
1564C-----------------------------------------------
1565C D u m m y A r g u m e n t s
1566C-----------------------------------------------
1567 INTEGER LLT
1568C REAL
1569 my_real
1570 . xx(mvsiz,*) ,yy(mvsiz,*),zz(mvsiz,*),
1571 . nx(mvsiz) ,ny(mvsiz) ,nz(mvsiz),
1572 . rr(mvsiz) ,ss(mvsiz) ,tt(mvsiz)
1573C-----------------------------------------------
1574C L o c a l V a r i a b l e s
1575C-----------------------------------------------
1576 INTEGER I,N
1577 my_real
1578 . dxdr(mvsiz), dydr(mvsiz), dzdr(mvsiz),
1579 . dxdt(mvsiz), dydt(mvsiz), dzdt(mvsiz),
1580 . dnidr(8),dnids(8),dnidt(8)
1581 my_real
1582 . u_m_r,u_p_r,u_m_s,u_p_s,u_m_t,u_p_t,
1583 . ums_umt,ums_upt,ups_umt,ups_upt,
1584 . umr_ums,umr_ups,upr_ums,upr_ups,
1585 . umt_umr,umt_upr,upt_umr,upt_upr,
1586 . a,r05,s05,t05,aa
1587C-----------------------------------------------------------------------
1588C Ni; dNi/dr; dNi/ds; dNi/dt s=+-1
1589C-----------------------------------------------------------------------
1590 DO i=1,llt
1591 r05 = half*rr(i)
1592 s05 = half*ss(i)
1593 t05 = half*tt(i)
1594C
1595 u_m_r = half - r05
1596 u_p_r = half + r05
1597C
1598 u_m_s = half - s05
1599 u_p_s = half + s05
1600C
1601 u_m_t = half - t05
1602 u_p_t = half + t05
1603C
1604 ums_umt = u_m_s * u_m_t
1605 ums_upt = u_m_s * u_p_t
1606 ups_umt = u_p_s * u_m_t
1607 ups_upt = u_p_s * u_p_t
1608C
1609 umr_ums = u_m_r * u_m_s
1610 umr_ups = u_m_r * u_p_s
1611 upr_ums = u_p_r * u_m_s
1612 upr_ups = u_p_r * u_p_s
1613C
1614 umt_umr = u_m_t * u_m_r
1615 umt_upr = u_m_t * u_p_r
1616 upt_umr = u_p_t * u_m_r
1617 upt_upr = u_p_t * u_p_r
1618C
1619 a = -t05 - rr(i)
1620 dnidr(1) = (-ums_umt - ups_umt) * a
1621 a = t05 - rr(i)
1622 dnidr(2) = (-ums_upt - ups_upt) * a
1623 a = t05 + rr(i)
1624 dnidr(3) = (ums_upt + ups_upt) * a
1625 a = -t05 + rr(i)
1626 dnidr(4) = (ums_umt + ups_umt) * a
1627C
1628 a = -r05 - tt(i)
1629 dnidt(1) = (-umr_ums - umr_ups) * a
1630 a = -r05 + tt(i)
1631 dnidt(2) = (umr_ums + umr_ups) * a
1632 a = +r05 + tt(i)
1633 dnidt(3) = (upr_ums + upr_ups) * a
1634 a = +r05 - tt(i)
1635 dnidt(4) = (-upr_ums - upr_ups) * a
1636C------------------------------------
1637 a = half*(one-rr(i)*rr(i))
1638 dnidt(6) = a * (u_m_s + u_p_s)
1639C
1640 a = -two*rr(i)
1641 dnidr(6) = a * (ums_upt + ups_upt)
1642 dnidr(8) = a * (ums_umt + ups_umt)
1643C------------------------------------
1644 a = half*(one-tt(i)*tt(i))
1645 dnidr(5) = -a * (u_m_s + u_p_s)
1646C
1647 a = -two*tt(i)
1648 dnidt(5) = a * (umr_ums + umr_ups)
1649 dnidt(7) = a * (upr_ums + upr_ups)
1650C-----------------------------------------------------------------------
1651C DX/DR;DX/DT
1652C-----------------------------------------------------------------------
1653 dxdr(i) = dnidr(1)*xx(i,1) + dnidr(2)*xx(i,2) + dnidr(3)*xx(i,3)
1654 + + dnidr(4)*xx(i,4)
1655 + + dnidr(5)*(xx(i,5) - xx(i,7)) + dnidr(6)*xx(i,6)
1656 + + dnidr(8)*xx(i,8)
1657C
1658 dxdt(i) = dnidt(1)*xx(i,1) + dnidt(2)*xx(i,2) + dnidt(3)*xx(i,3)
1659 + + dnidt(4)*xx(i,4)
1660 + + dnidt(5)*xx(i,5) + dnidt(6)*(xx(i,6) - xx(i,8))
1661 + + dnidt(7)*xx(i,7)
1662C-----------------------------------------------------------------------
1663C dy/dr; dy/dt
1664C-----------------------------------------------------------------------
1665 dydr(i) = dnidr(1)*yy(i,1) + dnidr(2)*yy(i,2) + dnidr(3)*yy(i,3)
1666 + + dnidr(4)*yy(i,4)
1667 + + dnidr(5)*(yy(i,5) - yy(i,7)) + dnidr(6)*yy(i,6)
1668 + + dnidr(8)*yy(i,8)
1669C
1670 dydt(i) = dnidt(1)*yy(i,1) + dnidt(2)*yy(i,2) + dnidt(3)*yy(i,3)
1671 + + dnidt(4)*yy(i,4)
1672 + + dnidt(5)*yy(i,5) + dnidt(6)*(yy(i,6) - yy(i,8))
1673 + + dnidt(7)*yy(i,7)
1674C-----------------------------------------------------------------------
1675C dz/dr; dz/dt
1676C-----------------------------------------------------------------------
1677 dzdr(i) = dnidr(1)*zz(i,1) + dnidr(2)*zz(i,2) + dnidr(3)*zz(i,3)
1678 + + dnidr(4)*zz(i,4)
1679 + + dnidr(5)*(zz(i,5) - zz(i,7)) + dnidr(6)*zz(i,6)
1680 + + dnidr(8)*zz(i,8)
1681C
1682 dzdt(i) = dnidt(1)*zz(i,1) + dnidt(2)*zz(i,2) + dnidt(3)*zz(i,3)
1683 + + dnidt(4)*zz(i,4)
1684 + + dnidt(5)*zz(i,5) + dnidt(6)*(zz(i,6) - zz(i,8))
1685 + + dnidt(7)*zz(i,7)
1686C-----------------------------------------------------------------------
1687C calculation of the normal -n
1688C-----------------------------------------------------------------------
1689 nx(i) = -dydt(i)*dzdr(i) + dzdt(i)*dydr(i)
1690 ny(i) = -dzdt(i)*dxdr(i) + dxdt(i)*dzdr(i)
1691 nz(i) = -dxdt(i)*dydr(i) + dydt(i)*dxdr(i)
1692C
1693 aa = one/sqrt(nx(i)*nx(i)+ny(i)*ny(i)+nz(i)*nz(i))
1694 nx(i) = nx(i)*aa
1695 ny(i) = ny(i)*aa
1696 nz(i) = nz(i)*aa
1697 ENDDO
1698c
1699 RETURN

◆ i17racine()

subroutine i17racine ( integer llt,
a,
b,
c,
r1,
r2 )

Definition at line 1318 of file i17lagm.F.

1319C-----------------------------------------------
1320C
1321C calculation des racines r1,r2 bornees a +- 1
1322C
1323C de a x^2 + b x + c = 0
1324C
1325C The routine returns -1,+1 if there are no roots
1326C-----------------------------------------------
1327C I m p l i c i t T y p e s
1328C-----------------------------------------------
1329#include "implicit_f.inc"
1330C-----------------------------------------------
1331C G l o b a l P a r a m e t e r s
1332C-----------------------------------------------
1333#include "mvsiz_p.inc"
1334C-----------------------------------------------
1335C D u m m y A r g u m e n t s
1336C-----------------------------------------------
1337 INTEGER LLT
1338 my_real
1339 . c(mvsiz),b(mvsiz),a(mvsiz),r1(mvsiz),r2(mvsiz)
1340C-----------------------------------------------
1341C L o c a l V a r i a b l e s
1342C-----------------------------------------------
1343 INTEGER I
1344 my_real
1345 . d
1346c
1347C
1348 DO i=1,llt
1349 d = b(i)*b(i) - four*a(i)*c(i)
1350 IF(abs(a(i))<em20)THEN
1351 IF(abs(b(i))<em20)THEN
1352 r1(i) = -one
1353 r2(i) = one
1354 ELSE
1355 r1(i) = -c(i) / b(i)
1356 r2(i) = b(i) / abs(b(i))
1357 ENDIF
1358 ELSEIF(d<zero)THEN
1359 r1(i) = -one
1360 r2(i) = one
1361 ELSE
1362 d = sqrt( d )
1363 r1(i) = (-b(i) - d) / (two*a(i))
1364 r2(i) = (-b(i) + d) / (two*a(i))
1365 ENDIF
1366 ENDDO
1367c-----------------------------------------------------------------------
1368c bound r (or t) at +-1 on the second
1369c-----------------------------------------------------------------------
1370 DO i=1,llt
1371 r1(i) = max(-one,min(one,r1(i)))
1372 r2(i) = max(-one,min(one,r2(i)))
1373 ENDDO
1374c
1375 RETURN

◆ i17rst()

subroutine i17rst ( integer llt,
r,
s,
t,
ni,
xx,
yy,
zz )

Definition at line 773 of file i17lagm.F.

775C-----------------------------------------------
776C I m p l i c i t T y p e s
777C-----------------------------------------------
778#include "implicit_f.inc"
779C-----------------------------------------------
780C G l o b a l P a r a m e t e r s
781C-----------------------------------------------
782#include "mvsiz_p.inc"
783C-----------------------------------------------
784C D u m m y A r g u m e n t s
785C-----------------------------------------------
786 INTEGER LLT
787C REAL
788 my_real
789 . xx(mvsiz,17),yy(mvsiz,17),zz(mvsiz,17)
790 my_real
791 . r(mvsiz),s(mvsiz),t(mvsiz),ni(mvsiz,17)
792C-----------------------------------------------
793C L o c a l V a r i a b l e s
794C-----------------------------------------------
795 INTEGER I,J,IK,NK,ITER,NITERMAX,JTER,NJTERMAX,CONV
796 my_real
797 . vx,vy,vz,vn
798 my_real
799 . drdx(mvsiz),drdy(mvsiz),drdz(mvsiz),
800 . dsdx(mvsiz),dsdy(mvsiz),dsdz(mvsiz),
801 . dtdx(mvsiz),dtdy(mvsiz),dtdz(mvsiz),
802 . dxdr(mvsiz),dydr(mvsiz),dzdr(mvsiz),
803 . dxdt(mvsiz),dydt(mvsiz),dzdt(mvsiz),
804 . rr(mvsiz),ss(mvsiz),tt(mvsiz)
805C-----------------------------------------------
806C
807C r=s=t=0
808C
809C +---> iter
810C |
811C | Ni(r,s,t) =
812C | dNi/dr =
813C | ... _
814C | \
815C | dx/dr = /_ (xi * dNi/dr)
816C | ...
817C |
818C | [dx/dr dy/dr dz/dr]
819C | [J] = |dx/ds dy/ds dz/ds|
820C | [dx/dt dy/dt dz/dt]
821C |
822C | +--> jter
823C | | _
824C | | \
825C | | x(r,s,t) = /_ (xi * Ni(r,s,t))
826C | | ...
827C | |
828C | | |r| |r| -1 |xs-x(r,s,t)|
829C | | {s} = {s} + [J] {ys-y(r,s,t)}
830C | | |t| |t| |zs-z(r,s,t)|
831C | |
832C | | Ni(r,s,t) =
833C +-+---
834C-----------------------------------------------
835 nitermax = 3
836 njtermax = 3
837 conv = 0
838C
839 DO i=1,llt
840 rr(i) = 0.
841 ss(i) = 0.
842 tt(i) = 0.
843 ENDDO
844C-----------------------------------------------
845C calculation de r,s,t et Ni(r,s,t)
846C-----------------------------------------------
847 DO iter=1,nitermax
848c
849c print *, "iter",iter
850c
851C-----------------------------------------------
852C calculation de Ni(r,s,t); [J]; [J]-1
853C-----------------------------------------------
854 CALL i16deri(llt,rr ,ss ,tt ,ni ,
855 2 drdx ,drdy ,drdz ,dsdx ,dsdy ,dsdz ,
856 3 dtdx ,dtdy ,dtdz ,dxdr ,dydr ,dzdr ,
857 4 dxdt ,dydt ,dzdt ,xx ,yy ,zz )
858C
859 DO jter=1,njtermax
860c
861c print *, "jter",jter
862c
863C-----------------------------------------------
864C calculation de r,s,t new
865C-----------------------------------------------
866 CALL i16rstn(llt,rr,ss ,tt ,ni ,conv ,
867 2 drdx ,drdy ,drdz ,dsdx ,dsdy ,dsdz ,
868 3 dtdx ,dtdy ,dtdz ,xx ,yy ,zz ,
869 4 r ,s ,t )
870c
871c print *, "r,s,t",r(1),s(1),t(1)
872c print *, "rr,ss,tt",rr(1),ss(1),tt(1)
873c
874C-----------------------------------------------
875C calculation de Ni(-1<r<1 , -1<s<1 , -1<t<1)
876C-----------------------------------------------
877 CALL i16ni(llt,rr ,ss ,tt ,ni )
878C
879 ENDDO
880 ENDDO
881C
882 RETURN
i16ni
subroutine i16ni(llt, rr, ss, tt, ni)
Definition i16lagm.F:642
i16rstn
subroutine i16rstn(llt, rr, ss, tt, ni, conv, drdx, drdy, drdz, dsdx, dsdy, dsdz, dtdx, dtdy, dtdz, xx, yy, zz, r, s, t)
Definition i16lagm.F:740
i16deri
subroutine i16deri(llt, rr, ss, tt, ni, drdx, drdy, drdz, dsdx, dsdy, dsdz, dtdx, dtdy, dtdz, dxdr, dydr, dzdr, dxdt, dydt, dzdt, xx, yy, zz)
Definition i16lagm.F:845

◆ i17vit4()

subroutine i17vit4 ( integer llt,
integer nint,
v,
a,
integer, dimension(mvsiz,17) iii,
integer, dimension(mvsiz,16) iiis,
ni_m,
ni_s,
nx,
ny,
nz,
vit,
integer, dimension(mvsiz) icont,
rm,
tm,
rs,
ts,
sm,
r_m,
t_m,
r_s,
t_s,
integer, dimension(mvsiz) icontn )

Definition at line 491 of file i17lagm.F.

495C-----------------------------------------------
496C I m p l i c i t T y p e s
497C-----------------------------------------------
498#include "implicit_f.inc"
499C-----------------------------------------------
500C G l o b a l P a r a m e t e r s
501C-----------------------------------------------
502#include "mvsiz_p.inc"
503C-----------------------------------------------
504C D u m m y A r g u m e n t s
505C-----------------------------------------------
506 INTEGER LLT,NINT
507 INTEGER III(MVSIZ,17),IIIS(MVSIZ,16),
508 + ICONT(MVSIZ),ICONTN(MVSIZ)
509C REAL
510 my_real
511 . v(3,*),a(3,*),vit(*)
512 my_real
513 . rm(mvsiz) ,rs(mvsiz) ,tm(mvsiz) ,ts(mvsiz) ,sm(mvsiz),
514 . r_m(mvsiz) ,r_s(mvsiz) ,t_m(mvsiz) ,t_s(mvsiz) ,
515 . ni_m(mvsiz,*) ,ni_s(mvsiz,*),nx(mvsiz) ,ny(mvsiz) ,nz(mvsiz)
516C-----------------------------------------------
517C L o c a l V a r i a b l e s
518C-----------------------------------------------
519 INTEGER I,J,IK,NK,I1,I2,I3,I4
520 my_real
521 . vx,vy,vz,vn,aa
522 my_real
523 . ni_ml(mvsiz,8) ,ni_sl(mvsiz,8)
524C-----------------------------------------------------------------------
525C calculation of Ni on face 1 2 3 4 or 5 6 7 8 of the main (s=+-1)
526C-----------------------------------------------------------------------
527 CALL i17ni(llt,rm ,tm ,ni_ml )
528C-----------------------------------------------------------------------
529C calculation of Ni on face 1 2 3 4 or 5 6 7 8 of the second (s=+-1)
530C-----------------------------------------------------------------------
531 CALL i17ni(llt,rs ,ts ,ni_sl )
532C-----------------------------------------------
533C calculation of [L]
534C-----------------------------------------------
535 DO i=1,llt
536C-----------------------------------------------
537C Test if contact
538C-----------------------------------------------
539 IF(icont(i)/=0)THEN
540C
541 vx = zero
542 vy = zero
543 vz = zero
544 DO ik=1,8
545c VX = VX - (V(1,III(I,IK))+DT12*A(1,III(I,IK)))*NI_M(I,IK)
546c VY = VY - (V(2,III(I,IK))+DT12*A(2,III(I,IK)))*NI_M(I,IK)
547c VZ = VZ - (V(3,III(I,IK))+DT12*A(3,III(I,IK)))*NI_M(I,IK)
548c VX = VX + (V(1,IIIS(I,IK))+DT12*A(1,IIIS(I,IK)))*NI_S(I,IK)
549c VY = VY + (V(2,IIIS(I,IK))+DT12*A(2,IIIS(I,IK)))*NI_S(I,IK)
550c VZ = VZ + (V(3,IIIS(I,IK))+DT12*A(3,IIIS(I,IK)))*NI_S(I,IK)
551 vx = vx - (v(1,iii(i,ik)))*ni_ml(i,ik)
552 vy = vy - (v(2,iii(i,ik)))*ni_ml(i,ik)
553 vz = vz - (v(3,iii(i,ik)))*ni_ml(i,ik)
554 vx = vx + (v(1,iiis(i,ik)))*ni_sl(i,ik)
555 vy = vy + (v(2,iiis(i,ik)))*ni_sl(i,ik)
556 vz = vz + (v(3,iiis(i,ik)))*ni_sl(i,ik)
557 ENDDO
558c
559 vn = nx(i)*vx + ny(i)*vy + nz(i)*vz
560C-----------------------------------------------
561C Test if incoming velocity in S
562C-----------------------------------------------
563 IF(sm(i)*vn<=vit(i))THEN
564c
565c print *, "velocity entrante",vn
566c print *, "s = ",S(I)
567c
568 vit(i)=sm(i)*vn
569 r_s(i)=rs(i)
570 r_m(i)=rm(i)
571 t_s(i)=ts(i)
572 t_m(i)=tm(i)
573 DO ik=1,8
574 ni_m(i,ik)=ni_ml(i,ik)
575 ni_s(i,ik)=ni_sl(i,ik)
576 ENDDO
577 icontn(i)=1
578 ENDIF
579 ENDIF
580 ENDDO
581c
582c print *, "r,s,t",r(1),s(1),t(1)
583C
584 RETURN
i17ni
subroutine i17ni(llt, r, t, ni)
Definition i17lagm.F:1255