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"
#include "lockon.inc"
#include "lockoff.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 1457 of file i17lagm.F.

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

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

◆ 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 31 of file i17lagm.F.

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

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

◆ 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 594 of file i17lagm.F.

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

◆ 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 892 of file i17lagm.F.

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

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

◆ i17norm()

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

Definition at line 1549 of file i17lagm.F.

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

◆ i17racine()

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

Definition at line 1315 of file i17lagm.F.

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

◆ i17rst()

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

Definition at line 770 of file i17lagm.F.

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

◆ 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 488 of file i17lagm.F.

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