OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i10lagm.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"
#include "constant.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i10lagm (x, v, lll, jll, sll, xll, candn, cande, i_stok, ixs, ixs10, iadll, eminx, nsv, nelem, n_mul_mx, itask, a, itied, nint, nkmax, comntag)
subroutine i10lll (llt, lll, jll, sll, xll, v, xx, yy, zz, iii, iadll, n_mul_mx, a, x, itied, nint, nkmax, comntag)
subroutine i10rst (llt, r, s, t, ni, nx, ny, nz, xx, yy, zz)
subroutine i10ni (llt, rr, ss, tt, ni)
subroutine i10rstn (llt, rr, ss, tt, ni, conv, drdx, drdy, drdz, dsdx, dsdy, dsdz, dtdx, dtdy, dtdz, xx, yy, zz, r, s, t)
subroutine i10deri (llt, rr, ss, tt, ni, drdx, drdy, drdz, dsdx, dsdy, dsdz, dtdx, dtdy, dtdz, dxdr, dydr, dzdr, dxdt, dydt, dzdt, xx, yy, zz)

Function/Subroutine Documentation

◆ i10deri()

subroutine i10deri ( integer llt,
rr,
ss,
tt,
ni,
drdx,
drdy,
drdz,
dsdx,
dsdy,
dsdz,
dtdx,
dtdy,
dtdz,
dxdr,
dydr,
dzdr,
dxdt,
dydt,
dzdt,
xx,
yy,
zz )

Definition at line 787 of file i10lagm.F.

791C-----------------------------------------------
792C I m p l i c i t T y p e s
793C-----------------------------------------------
794#include "implicit_f.inc"
795C-----------------------------------------------
796C G l o b a l P a r a m e t e r s
797C-----------------------------------------------
798#include "mvsiz_p.inc"
799C-----------------------------------------------
800C D u m m y A r g u m e n t s
801C-----------------------------------------------
802 INTEGER LLT
803 my_real
804 . dxdr(mvsiz), dydr(mvsiz), dzdr(mvsiz),
805 . dxdt(mvsiz), dydt(mvsiz), dzdt(mvsiz),
806 . drdx(mvsiz), dsdx(mvsiz), dtdx(mvsiz),
807 . drdy(mvsiz), dsdy(mvsiz), dtdy(mvsiz),
808 . drdz(mvsiz), dsdz(mvsiz), dtdz(mvsiz),
809 . xx(mvsiz,7) ,yy(mvsiz,7),zz(mvsiz,7),
810 . ni(mvsiz,7) ,rr(mvsiz) ,ss(mvsiz) ,tt(mvsiz)
811C-----------------------------------------------
812C L o c a l V a r i a b l e s
813C-----------------------------------------------
814 INTEGER I
815 my_real
816 . dxds(mvsiz), dyds(mvsiz), dzds(mvsiz),
817 . dnidr(10),dnids(10),dnidt(10),
818 . d, det(mvsiz)
819 my_real
820 . u_m_r,u_p_r,u_m_s,u_p_s,u_m_t,u_p_t,
821 . ums_umt,ums_upt,ups_umt,ups_upt,
822 . umr_ums,umr_ups,upr_ums,upr_ups,
823 . umt_umr,umt_upr,upt_umr,upt_upr,
824 . a,r05,s05,t05
825C-----------------------------------------------
826C/*
827C
828C
829C*/
830C-----------------------------------------------
831C
832C-----------------------------------------------
833C _
834C \
835C x(r,s,t) = /_ (xi * Ni(r,s,t))
836C _
837C \
838C y(r,s,t) = /_ (yi * Ni(r,s,t))
839C _
840C \
841C z(r,s,t) = /_ zi * Ni(r,s,t))
842C
843C _
844C \
845C dx/dr = /_ (xi * dNi/dr)
846C ...
847C
848C [dx/dr dy/dr dz/dr]
849C [J] = |dx/ds dy/ds dz/ds|
850C [dx/dt dy/dt dz/dt]
851C
852C |r| |r| -1 |xs-x|
853C {s} = {s} + [J] {ys-y}
854C |t| |t| |zs-z|
855C
856C-----------------------------------------------------------------------
857C Ni; dNi/dr; dNi/ds; dNi/dt
858C-----------------------------------------------------------------------
859 DO i=1,llt
860 r05 = half*rr(i)
861 s05 = half*ss(i)
862 t05 = half*tt(i)
863C
864 u_m_r = half - r05
865 u_p_r = half + r05
866C
867 u_m_s = half - s05
868 u_p_s = half + s05
869C
870 u_m_t = half - t05
871 u_p_t = half + t05
872C
873 ums_umt = u_m_s * u_m_t
874 ums_upt = u_m_s * u_p_t
875 ups_umt = u_p_s * u_m_t
876 ups_upt = u_p_s * u_p_t
877C
878 umr_ums = u_m_r * u_m_s
879 umr_ups = u_m_r * u_p_s
880 upr_ums = u_p_r * u_m_s
881 upr_ups = u_p_r * u_p_s
882C
883 umt_umr = u_m_t * u_m_r
884 umt_upr = u_m_t * u_p_r
885 upt_umr = u_p_t * u_m_r
886 upt_upr = u_p_t * u_p_r
887C
888 a = -rr(i)-tt(i)-one
889 ni(i,1) = u_m_r * ums_umt * a
890 ni(i,2) = u_m_r * ums_upt * a
891 ni(i,3) = u_p_r * ums_upt * a
892 ni(i,4) = u_p_r * ums_umt * a
893 ni(i,5) = u_m_r * ups_umt * a
894 ni(i,6) = u_m_r * ups_upt * a
895C
896 a = -t05 - rr(i)
897 dnidr(1) = -ums_umt * a
898 dnidr(5) = -ups_umt * a
899 dnidr(2) = -ums_upt * a
900 dnidr(6) = -ups_upt * a
901 dnidr(3) = ums_upt * a
902 dnidr(4) = ums_umt * a
903C
904 dnids(1) = -umt_umr * a
905 dnids(5) = umt_umr * a
906 dnids(2) = -upt_umr * a
907 dnids(6) = upt_umr * a
908 dnids(3) = -upt_upr * a
909 dnids(4) = -umt_upr * a
910C
911 dnidt(1) = -umr_ums * a
912 dnidt(5) = -umr_ups * a
913 dnidt(2) = umr_ums * a
914 dnidt(6) = umr_ups * a
915 dnidt(3) = upr_ums * a
916 dnidt(4) = -upr_ums * a
917C------------------------------------
918 ni(i,7) = -1.
919C-----------------------------------------------------------------------
920C dx/dr; dx/ds; dx/dt
921C-----------------------------------------------------------------------
922 dxdr(i) = dnidr(1)*xx(i,1) + dnidr(2)*xx(i,2) + dnidr(3)*xx(i,3)
923 + + dnidr(4)*xx(i,4) + dnidr(5)*xx(i,5) + dnidr(6)*xx(i,6)
924C
925 dxds(i) = dnids(1)*xx(i,1) + dnids(2)*xx(i,2) + dnids(3)*xx(i,3)
926 + + dnids(4)*xx(i,4) + dnids(5)*xx(i,5) + dnids(6)*xx(i,6)
927C
928 dxdt(i) = dnidt(1)*xx(i,1) + dnidt(2)*xx(i,2) + dnidt(3)*xx(i,3)
929 + + dnidt(4)*xx(i,4) + dnidt(5)*xx(i,5) + dnidt(6)*xx(i,6)
930C-----------------------------------------------------------------------
931C dy/dr; dy/ds; dy/dt
932C-----------------------------------------------------------------------
933 dydr(i) = dnidr(1)*yy(i,1) + dnidr(2)*yy(i,2) + dnidr(3)*yy(i,3)
934 + + dnidr(4)*yy(i,4) + dnidr(5)*yy(i,5) + dnidr(6)*yy(i,6)
935C
936 dyds(i) = dnids(1)*yy(i,1) + dnids(2)*yy(i,2) + dnids(3)*yy(i,3)
937 + + dnids(4)*yy(i,4) + dnids(5)*yy(i,5) + dnids(6)*yy(i,6)
938C
939 dydt(i) = dnidt(1)*yy(i,1) + dnidt(2)*yy(i,2) + dnidt(3)*yy(i,3)
940 + + dnidt(4)*yy(i,4) + dnidt(5)*yy(i,5) + dnidt(6)*yy(i,6)
941C-----------------------------------------------------------------------
942C dz/dr; dz/ds; dz/dt
943C-----------------------------------------------------------------------
944 dzdr(i) = dnidr(1)*zz(i,1) + dnidr(2)*zz(i,2) + dnidr(3)*zz(i,3)
945 + + dnidr(4)*zz(i,4) + dnidr(5)*zz(i,5) + dnidr(6)*zz(i,6)
946C
947 dzds(i) = dnids(1)*zz(i,1) + dnids(2)*zz(i,2) + dnids(3)*zz(i,3)
948 + + dnids(4)*zz(i,4) + dnids(5)*zz(i,5) + dnids(6)*zz(i,6)
949C
950 dzdt(i) = dnidt(1)*zz(i,1) + dnidt(2)*zz(i,2) + dnidt(3)*zz(i,3)
951 + + dnidt(4)*zz(i,4) + dnidt(5)*zz(i,5) + dnidt(6)*zz(i,6)
952C-----------------------------------------------------------------------
953C -1
954C [J] inversion of the jacobian
955C-----------------------------------------------------------------------
956 drdx(i)=dyds(i)*dzdt(i)-dzds(i)*dydt(i)
957 drdy(i)=dzds(i)*dxdt(i)-dxds(i)*dzdt(i)
958 drdz(i)=dxds(i)*dydt(i)-dyds(i)*dxdt(i)
959C
960 dsdz(i)=dxdt(i)*dydr(i)-dydt(i)*dxdr(i)
961 dsdy(i)=dzdt(i)*dxdr(i)-dxdt(i)*dzdr(i)
962 dsdx(i)=dydt(i)*dzdr(i)-dzdt(i)*dydr(i)
963C
964 dtdx(i)=dydr(i)*dzds(i)-dzdr(i)*dyds(i)
965 dtdy(i)=dzdr(i)*dxds(i)-dxdr(i)*dzds(i)
966 dtdz(i)=dxdr(i)*dyds(i)-dydr(i)*dxds(i)
967C
968 det(i) = dxdr(i) * drdx(i)
969 . + dydr(i) * drdy(i)
970 . + dzdr(i) * drdz(i)
971C
972c
973c
974 ENDDO
975C
976 DO i=1,llt
977C-----------------------------------------------------------------------
978C -1
979C [J] Inversion of the Jacobian Suite
980C-----------------------------------------------------------------------
981 d = one/det(i)
982 drdx(i)=d*drdx(i)
983 dsdx(i)=d*dsdx(i)
984 dtdx(i)=d*dtdx(i)
985C
986 drdy(i)=d*drdy(i)
987 dsdy(i)=d*dsdy(i)
988 dtdy(i)=d*dtdy(i)
989C
990 drdz(i)=d*drdz(i)
991 dsdz(i)=d*dsdz(i)
992 dtdz(i)=d*dtdz(i)
993C
994c
995c print *, "DRDX(I),DRDY(I),DRDZ(I)",DRDX(I),DRDY(I),DRDZ(I)
996c print *, "DSDX(I),DSDY(I),DSDZ(I)",DSDX(I),DSDY(I),DSDZ(I)
997c print *, "DTDX(I),DTDY(I),DTDZ(I)",DTDX(I),DTDY(I),DTDZ(I)
998c
999 ENDDO
1000C-----------------------------------------------------------------------
1001 RETURN
#define my_real
Definition cppsort.cpp:32

◆ i10lagm()

subroutine i10lagm ( 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(6,*) ixs10,
integer, dimension(*) iadll,
eminx,
integer, dimension(*) nsv,
integer, dimension(*) nelem,
integer n_mul_mx,
integer itask,
a,
integer itied,
integer nint,
integer nkmax,
integer, dimension(*) comntag )

Definition at line 32 of file i10lagm.F.

37 use element_mod , only : nixs
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C G l o b a l P a r a m e t e r s
44C-----------------------------------------------
45#include "mvsiz_p.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "task_c.inc"
50#include "com04_c.inc"
51#include "com08_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER I_STOK,N_MUL_MX,ITASK,ITIED,NINT,NKMAX ,
56 . LLL(*),JLL(*),SLL(*),CANDN(*),CANDE(*),COMNTAG(*),
57 . IXS(NIXS,*),IXS10(6,*),IADLL(*),NSV(*) ,NELEM(*)
58C REAL
60 . x(3,*),v(3,*),xll(*),
61 . eminx(6,*),a(3,*)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I, K, IE, IS, IC, III(MVSIZ, 7), LLT, NFT, LE, FIRST, LAST,
66 . I10
68 . xx(mvsiz,7),yy(mvsiz,7),zz(mvsiz,7),
69 . dist
70C-----------------------------------------------
71C
72C
73C | M | Lt| | a | M ao
74C |---+---| | = |
75C | L | 0 | | lambda | bo
76C
77C [M] a + [L]t la = [M] ao
78C [L] a = bo
79C
80C a = -[M]-1[L]t la + ao
81C [L][M]-1[L]t la = [L] ao - bo
82C
83C on pose:
84C [H] = [L][M]-1[L]t
85C b = [L] ao - bo
86C
87C [H] lambda = b
88C
89C a = ao - [M]-1[L]t la
90C-----------------------------------------------
91C
92C lambda : LAMBDA(NC)
93C ao : A(NUMNOD)
94C L : XLL(NK,NC)
95C M : MAS(NUMNOD)
96C [L][M]-1[L]t la : HLA(NC)
97C [L] ao - b : B(NC)
98C [M]-1[L]t la : LTLA(NUMNOD)
99C
100C NC : number of contacts
101C NK: Number of node for contact (8+1.16+1.8+8.16+16)
102C
103C IC : contact number (1,NC)
104C IK : local node number for a contact (1,NK)
105C I : global node number (1,NUMNOD)
106C
107C IADLL(NC) : IAD = IADLL(IC)
108C LLL(NC*(7,21)) : I = LLL(IAD+1,2...IADNEXT-1)
109C-----------------------------------------------
110C evaluation of b:
111C
112C Vs = Somme(Ni Vi)
113C Vs_ + dt As = Somme(Ni Vi_) + Somme(dt Ni Ai)
114C Somme(dt Ni Ai) - dt As = Vs_ -Somme(Ni Vi_)
115C [L] = dt {N1,N2,..,N15,-1}
116C bo = [L] a = -[L]/dt v_
117C b = [L] ao - bo
118C b = [L] ao + [L]/dt v_ = [L] (v_ + ao dt)/dt
119C-----------------------------------------------
120C b = [L] vo+/dt + vout
121C-----------------------------------------------
122C-----------------------------------------------------------------------
123C loop over contact candidates
124C-----------------------------------------------------------------------
125 first = 1 + i_stok * itask / nthread
126 last = i_stok*(itask+1) / nthread
127 llt = 0
128 nft=llt+1
129 DO ic=first,last
130 le = cande(ic)
131 ie = nelem(le)
132 i10 = ie - numels8
133C-----------------------------------------------------------------------
134C test si shell 16
135C-----------------------------------------------------------------------
136 IF(i10.ge .1.AND.i10.le .numels10)THEN
137 is = nsv(candn(ic))
138 dist = -1.e30
139 dist = max(eminx(1,le)-x(1,is)-dt2*(v(1,is)+dt12*a(1,is)),
140 . x(1,is)+dt2*(v(1,is)+dt12*a(1,is))-eminx(4,le),dist)
141 dist = max(eminx(2,le)-x(2,is)-dt2*(v(2,is)+dt12*a(2,is)),
142 . x(2,is)+dt2*(v(2,is)+dt12*a(2,is))-eminx(5,le),dist)
143 dist = max(eminx(3,le)-x(3,is)-dt2*(v(3,is)+dt12*a(3,is)),
144 . x(3,is)+dt2*(v(3,is)+dt12*a(3,is))-eminx(6,le),dist)
145c IF (DIST<0.) CANDN(I) = -CANDN(I)
146C-----------------------------------------------------------------------
147C test if inside the box
148C-----------------------------------------------------------------------
149 IF(dist.le .zero)THEN
150c
151c print *, "in la boite",XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX
152c
153 llt = llt+1
154 iii(llt,7)=is
155 xx(llt,7)=x(1,is)
156 yy(llt,7)=x(2,is)
157 zz(llt,7)=x(3,is)
158 iii(llt,1)=ixs(2,ie)
159 iii(llt,2)=ixs(4,ie)
160 iii(llt,3)=ixs(6,ie)
161 iii(llt,4)=ixs(7,ie)
162 DO k=1,6
163 iii(llt,k+8)=ixs10(k,i10)
164 ENDDO
165 DO k=1,7
166 i = iii(llt,k)
167 xx(llt,k)=x(1,i)
168 yy(llt,k)=x(2,i)
169 zz(llt,k)=x(3,i)
170 ENDDO
171c
172C-----------------------------------------------------------------------
173C calculation of [L] by packet of mvsiz
174C-----------------------------------------------------------------------
175 IF(llt==mvsiz-1)THEN
176 CALL i10lll(
177 1 llt ,lll ,jll ,sll ,xll ,v ,
178 2 xx ,yy ,zz ,iii ,iadll ,
179 3 n_mul_mx ,a ,x ,itied ,nint ,nkmax ,
180 4 comntag )
181 nft=llt+1
182 llt = 0
183 ENDIF
184 ELSE
185c debug
186 k=0
187 ENDIF
188 ENDIF
189 ENDDO
190C-----------------------------------------------------------------------
191C calculation of [L] for last packet
192C-----------------------------------------------------------------------
193 IF(llt/=0) CALL i10lll(
194 1 llt ,lll ,jll ,sll ,xll ,v ,
195 2 xx ,yy ,zz ,iii ,iadll ,
196 3 n_mul_mx ,a ,x ,itied ,nint ,nkmax ,
197 4 comntag )
198C
199C-----------------------------------------------
200 RETURN
subroutine i10lll(llt, lll, jll, sll, xll, v, xx, yy, zz, iii, iadll, n_mul_mx, a, x, itied, nint, nkmax, comntag)
Definition i10lagm.F:217
#define max(a, b)
Definition macros.h:21

◆ i10lll()

subroutine i10lll ( integer llt,
integer, dimension(*) lll,
integer, dimension(*) jll,
integer, dimension(*) sll,
xll,
v,
xx,
yy,
zz,
integer, dimension(mvsiz,7) iii,
integer, dimension(*) iadll,
integer n_mul_mx,
a,
x,
integer itied,
integer nint,
integer nkmax,
integer, dimension(*) comntag )

Definition at line 213 of file i10lagm.F.

217C-----------------------------------------------
218C M o d u l e s
219C-----------------------------------------------
220 USE message_mod
221C-----------------------------------------------
222C I m p l i c i t T y p e s
223C-----------------------------------------------
224#include "implicit_f.inc"
225#include "comlock.inc"
226C-----------------------------------------------
227C G l o b a l P a r a m e t e r s
228C-----------------------------------------------
229#include "mvsiz_p.inc"
230C-----------------------------------------------
231C C o m m o n B l o c k s
232C-----------------------------------------------
233#include "com08_c.inc"
234 COMMON /lagglob/n_mult
235 INTEGER N_MULT
236C-----------------------------------------------
237C D u m m y A r g u m e n t s
238C-----------------------------------------------
239 INTEGER LLT,N_MUL_MX,ITIED,NINT ,NKMAX
240 INTEGER LLL(*),JLL(*),SLL(*),COMNTAG(*),
241 . III(MVSIZ,7),IADLL(*)
242C REAL
243 my_real
244 . xll(*),v(3,*),a(3,*)
245 my_real
246 . xx(mvsiz,7),yy(mvsiz,7),zz(mvsiz,7),x(3,*)
247C-----------------------------------------------
248C L o c a l V a r i a b l e s
249C-----------------------------------------------
250 INTEGER I, IK, NK, IAD, NN
251 my_real
252 . vx,vy,vz,vn,aa
253 my_real
254 . r(mvsiz),s(mvsiz),t(mvsiz),
255 . nx(mvsiz), ny(mvsiz), nz(mvsiz),
256 . ni(mvsiz,7)
257C-----------------------------------------------
258C calculation de r,s,t
259C-----------------------------------------------
260c
261c print *, "XX(1,1),XX(1,9)",XX(1,1),XX(1,9)
262c
263 CALL i10rst(llt ,r ,s ,t ,ni ,
264 2 nx ,ny ,nz ,xx ,yy ,zz )
265C-----------------------------------------------
266C calculation of [L]
267C-----------------------------------------------
268 IF(itied==0)THEN
269 DO i=1,llt
270C-----------------------------------------------
271C Test if contact
272C-----------------------------------------------
273 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
274 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
275C
276 nk = 7
277 vx = zero
278 vy = zero
279 vz = zero
280 DO ik=1,nk
281 vx = vx - (v(1,iii(i,ik))+dt12*a(1,iii(i,ik)))*ni(i,ik)
282 vy = vy - (v(2,iii(i,ik))+dt12*a(2,iii(i,ik)))*ni(i,ik)
283 vz = vz - (v(3,iii(i,ik))+dt12*a(3,iii(i,ik)))*ni(i,ik)
284 ENDDO
285c
286c
287 vn = nx(i)*vx + ny(i)*vy + nz(i)*vz
288C-----------------------------------------------
289C Test if incoming velocity in S
290C-----------------------------------------------
291 IF(s(i)*vn<=zero)THEN
292c
293c print *, "velocity entrante",vn
294c print *, "s = ",S(I)
295c
296 aa = one/sqrt(nx(i)*nx(i)+ny(i)*ny(i)+nz(i)*nz(i))
297 nx(i) = nx(i)*aa
298 ny(i) = ny(i)*aa
299 nz(i) = nz(i)*aa
300#include "lockon.inc"
301 n_mult=n_mult+1
302 IF(n_mult>n_mul_mx)THEN
303#include "lockoff.inc"
304 CALL ancmsg(msgid=84,anmode=aninfo)
305 CALL arret(2)
306 ENDIF
307 iadll(n_mult+1)=iadll(n_mult) + 21
308 IF(iadll(n_mult+1)-1>nkmax)THEN
309#include "lockoff.inc"
310 CALL ancmsg(msgid=84,anmode=aninfo)
311 CALL arret(2)
312 ENDIF
313 iad = iadll(n_mult) - 1
314 DO ik=1,7
315 lll(iad+ik) = iii(i,ik)
316 jll(iad+ik) = 1
317 sll(iad+ik) = 0
318 xll(iad+ik) = nx(i)*ni(i,ik)
319 lll(iad+ik+7) = iii(i,ik)
320 jll(iad+ik+7) = 2
321 sll(iad+ik+7) = 0
322 xll(iad+ik+7) = ny(i)*ni(i,ik)
323 lll(iad+ik+14) = iii(i,ik)
324 jll(iad+ik+14) = 3
325 sll(iad+ik+14) = 0
326 xll(iad+ik+14) = nz(i)*ni(i,ik)
327 nn = lll(iad+ik)
328 comntag(nn) = comntag(nn) + 1
329 ENDDO
330 sll(iad+7) = nint
331 sll(iad+14) = nint
332 sll(iad+21) = nint
333#include "lockoff.inc"
334 ENDIF
335 ENDIF
336 ENDDO
337 ELSEIF(itied==1)THEN
338C-----------------------------------------------
339C ITIED = 1
340C-----------------------------------------------
341 DO i=1,llt
342C-----------------------------------------------
343C Test if contact
344C-----------------------------------------------
345 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
346 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
347C
348 nk = 7
349 vx = zero
350 vy = zero
351 vz = zero
352 DO ik=1,nk
353 vx = vx - (v(1,iii(i,ik))+dt12*a(1,iii(i,ik)))*ni(i,ik)
354 vy = vy - (v(2,iii(i,ik))+dt12*a(2,iii(i,ik)))*ni(i,ik)
355 vz = vz - (v(3,iii(i,ik))+dt12*a(3,iii(i,ik)))*ni(i,ik)
356 ENDDO
357c
358c print *, "vx,vy,vz s-m",vx,vy,vz
359c print *, "nx,ny,nz ", NX(I),NY(I),NZ(I)
360c
361 vn = nx(i)*vx + ny(i)*vy + nz(i)*vz
362C-----------------------------------------------
363C Test if incoming velocity in S
364C-----------------------------------------------
365 IF(s(i)*vn<=zero)THEN
366c
367c print *, "velocity entrante",vn
368c print *, "s = ",S(I)
369c
370#include "lockon.inc"
371 IF(n_mult+3>n_mul_mx)THEN
372#include "lockoff.inc"
373 CALL ancmsg(msgid=84,anmode=aninfo)
374 CALL arret(2)
375 ENDIF
376 IF(iadll(n_mult+1)-1+7*3>nkmax)THEN
377#include "lockoff.inc"
378 CALL ancmsg(msgid=84,anmode=aninfo)
379 CALL arret(2)
380 ENDIF
381C
382 n_mult=n_mult+1
383 iadll(n_mult+1)=iadll(n_mult) + 7
384 iad = iadll(n_mult) - 1
385 DO ik=1,7
386 lll(iad+ik) = iii(i,ik)
387 jll(iad+ik) = 1
388 sll(iad+ik) = 0
389 xll(iad+ik) = ni(i,ik)
390 nn = lll(iad+ik)
391 comntag(nn) = comntag(nn) + 1
392 ENDDO
393 sll(iad+7) = nint
394C
395 n_mult=n_mult+1
396 iadll(n_mult+1)=iadll(n_mult) + 7
397 iad = iadll(n_mult) - 1
398 DO ik=1,7
399 lll(iad+ik) = iii(i,ik)
400 jll(iad+ik) = 2
401 sll(iad+ik) = 0
402 xll(iad+ik) = ni(i,ik)
403 nn = lll(iad+ik)
404 comntag(nn) = comntag(nn) + 1
405 ENDDO
406 sll(iad+7) = nint
407C
408 n_mult=n_mult+1
409 iadll(n_mult+1)=iadll(n_mult) + 7
410 iad = iadll(n_mult) - 1
411 DO ik=1,7
412 lll(iad+ik) = iii(i,ik)
413 jll(iad+ik) = 3
414 sll(iad+ik) = 0
415 xll(iad+ik) = ni(i,ik)
416 nn = lll(iad+ik)
417 comntag(nn) = comntag(nn) + 1
418 ENDDO
419 sll(iad+7) = nint
420#include "lockoff.inc"
421 ENDIF
422 ENDIF
423 ENDDO
424 ELSE
425C-----------------------------------------------
426C ITIED = 2
427C-----------------------------------------------
428 DO i=1,llt
429C-----------------------------------------------
430C Test if contact
431C-----------------------------------------------
432 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
433 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
434C
435 nk = 7
436C-----------------------------------------------
437c print *, "s = ",S(I)
438c
439#include "lockon.inc"
440 IF(n_mult+3>n_mul_mx)THEN
441#include "lockoff.inc"
442 CALL ancmsg(msgid=84,anmode=aninfo)
443 CALL arret(2)
444 ENDIF
445 IF(iadll(n_mult+1)-1+7*3>nkmax)THEN
446#include "lockoff.inc"
447 CALL ancmsg(msgid=84,anmode=aninfo)
448 CALL arret(2)
449 ENDIF
450 n_mult=n_mult+1
451 iadll(n_mult+1)=iadll(n_mult) + 7
452 iad = iadll(n_mult) - 1
453 DO ik=1,7
454 lll(iad+ik) = iii(i,ik)
455 jll(iad+ik) = 1
456 sll(iad+ik) = 0
457 xll(iad+ik) = ni(i,ik)
458 nn = lll(iad+ik)
459 comntag(nn) = comntag(nn) + 1
460 ENDDO
461 sll(iad+7) = nint
462C
463 n_mult=n_mult+1
464 iadll(n_mult+1)=iadll(n_mult) + 7
465 iad = iadll(n_mult) - 1
466 DO ik=1,7
467 lll(iad+ik) = iii(i,ik)
468 jll(iad+ik) = 2
469 sll(iad+ik) = 0
470 xll(iad+ik) = ni(i,ik)
471 nn = lll(iad+ik)
472 comntag(nn) = comntag(nn) + 1
473 ENDDO
474 sll(iad+7) = nint
475C
476 n_mult=n_mult+1
477 iadll(n_mult+1)=iadll(n_mult) + 7
478 iad = iadll(n_mult) - 1
479 DO ik=1,7
480 lll(iad+ik) = iii(i,ik)
481 jll(iad+ik) = 3
482 sll(iad+ik) = 0
483 xll(iad+ik) = ni(i,ik)
484 nn = lll(iad+ik)
485 comntag(nn) = comntag(nn) + 1
486 ENDDO
487 sll(iad+7) = nint
488C
489#include "lockoff.inc"
490 ENDIF
491 ENDDO
492 ENDIF
493c
494c print *, "r,s,t",r(1),s(1),t(1)
495C
496 RETURN
subroutine i10rst(llt, r, s, t, ni, nx, ny, nz, xx, yy, zz)
Definition i10lagm.F:510
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
subroutine arret(nn)
Definition arret.F:86

◆ i10ni()

subroutine i10ni ( integer llt,
rr,
ss,
tt,
ni )

Definition at line 631 of file i10lagm.F.

632C-----------------------------------------------
633C I m p l i c i t T y p e s
634C-----------------------------------------------
635#include "implicit_f.inc"
636C-----------------------------------------------
637C G l o b a l P a r a m e t e r s
638C-----------------------------------------------
639#include "mvsiz_p.inc"
640C-----------------------------------------------
641C D u m m y A r g u m e n t s
642C-----------------------------------------------
643 INTEGER LLT
644 my_real
645 . rr(mvsiz),ss(mvsiz),tt(mvsiz),ni(mvsiz,7)
646C-----------------------------------------------
647C L o c a l V a r i a b l e s
648C-----------------------------------------------
649 INTEGER I
650 my_real
651 . u_m_r,u_p_r,u_m_s,u_p_s,u_m_t,u_p_t,
652 . ums_umt,ums_upt,ups_umt,ups_upt,
653 . umr_ums,umr_ups,upr_ums,upr_ups,
654 . umt_umr,umt_upr,upt_umr,upt_upr,
655 . a,r05,s05,t05
656C-----------------------------------------------------------------------
657C calculation of Ni
658C-----------------------------------------------------------------------
659 DO i=1,llt
660C
661 r05 = half*rr(i)
662 s05 = half*ss(i)
663 t05 = half*tt(i)
664C
665 u_m_r = half - r05
666 u_p_r = half + r05
667C
668 u_m_s = half - s05
669 u_p_s = half + s05
670C
671 u_m_t = half - t05
672 u_p_t = half + t05
673C
674 ums_umt = u_m_s * u_m_t
675 ums_upt = u_m_s * u_p_t
676 ups_umt = u_p_s * u_m_t
677 ups_upt = u_p_s * u_p_t
678C
679 umr_ums = u_m_r * u_m_s
680 umr_ups = u_m_r * u_p_s
681 upr_ums = u_p_r * u_m_s
682 upr_ups = u_p_r * u_p_s
683C
684 umt_umr = u_m_t * u_m_r
685 umt_upr = u_m_t * u_p_r
686 upt_umr = u_p_t * u_m_r
687 upt_upr = u_p_t * u_p_r
688C
689 a = -rr(i)-tt(i)-one
690 ni(i,1) = u_m_r * ums_umt * a
691 ni(i,2) = u_m_r * ums_upt * a
692 ni(i,3) = u_p_r * ums_upt * a
693 ni(i,4) = u_p_r * ums_umt * a
694 ni(i,5) = u_m_r * ups_umt * a
695 ni(i,6) = u_m_r * ups_upt * a
696C------------------------------------
697 ni(i,7) = -1.
698C------------------------------------
699 ENDDO
700C-----------------------------------------------
701 RETURN

◆ i10rst()

subroutine i10rst ( integer llt,
r,
s,
t,
ni,
nx,
ny,
nz,
xx,
yy,
zz )

Definition at line 508 of file i10lagm.F.

510C-----------------------------------------------
511C I m p l i c i t T y p e s
512C-----------------------------------------------
513#include "implicit_f.inc"
514C-----------------------------------------------
515C G l o b a l P a r a m e t e r s
516C-----------------------------------------------
517#include "mvsiz_p.inc"
518C-----------------------------------------------
519C D u m m y A r g u m e n t s
520C-----------------------------------------------
521 INTEGER LLT
522C REAL
523 my_real
524 . xx(mvsiz,7),yy(mvsiz,7),zz(mvsiz,7)
525 my_real
526 . r(mvsiz),s(mvsiz),t(mvsiz),ni(mvsiz,7) ,
527 . nx(mvsiz),ny(mvsiz),nz(mvsiz)
528C-----------------------------------------------
529C L o c a l V a r i a b l e s
530C-----------------------------------------------
531 INTEGER I, ITER, NITERMAX, JTER, NJTERMAX, CONV
532 my_real
533 . drdx(mvsiz),drdy(mvsiz),drdz(mvsiz),
534 . dsdx(mvsiz),dsdy(mvsiz),dsdz(mvsiz),
535 . dtdx(mvsiz),dtdy(mvsiz),dtdz(mvsiz),
536 . dxdr(mvsiz),dydr(mvsiz),dzdr(mvsiz),
537 . dxdt(mvsiz),dydt(mvsiz),dzdt(mvsiz),
538 . rr(mvsiz),ss(mvsiz),tt(mvsiz)
539C-----------------------------------------------
540C
541C r=s=t=0
542C
543C +---> iter
544C |
545C | Ni(r,s,t) =
546C | dNi/dr =
547C | ... _
548C | \
549C | dx/dr = /_ (xi * dNi/dr)
550C | ...
551C |
552C | [dx/dr dy/dr dz/dr]
553C | [J] = |dx/ds dy/ds dz/ds|
554C | [dx/dt dy/dt dz/dt]
555C |
556C | +--> jter
557C | | _
558C | | \
559C | | x(r,s,t) = /_ (xi * Ni(r,s,t))
560C | | ...
561C | |
562C | | |r| |r| -1 |xs-x(r,s,t)|
563C | | {s} = {s} + [J] {ys-y(r,s,t)}
564C | | |t| |t| |zs-z(r,s,t)|
565C | |
566C | | Ni(r,s,t) =
567C +-+---
568C-----------------------------------------------
569 nitermax = 3
570 njtermax = 3
571 conv = 0
572C
573 DO i=1,llt
574 rr(i) = zero
575 ss(i) = zero
576 tt(i) = zero
577 ENDDO
578C-----------------------------------------------
579C calculation de r,s,t et Ni(r,s,t)
580C-----------------------------------------------
581 DO iter=1,nitermax
582c
583c print *, "iter",iter
584c
585C-----------------------------------------------
586C calculation de Ni(r,s,t); [J]; [J]-1
587C-----------------------------------------------
588 CALL i10deri(llt,rr ,ss ,tt ,ni ,
589 2 drdx ,drdy ,drdz ,dsdx ,dsdy ,dsdz ,
590 3 dtdx ,dtdy ,dtdz ,dxdr ,dydr ,dzdr ,
591 4 dxdt ,dydt ,dzdt ,xx ,yy ,zz )
592C
593 DO jter=1,njtermax
594c
595c print *, "jter",jter
596c
597C-----------------------------------------------
598C calculation de r,s,t new
599C-----------------------------------------------
600 CALL i10rstn(llt,rr,ss ,tt ,ni ,conv ,
601 2 drdx ,drdy ,drdz ,dsdx ,dsdy ,dsdz ,
602 3 dtdx ,dtdy ,dtdz ,xx ,yy ,zz ,
603 4 r ,s ,t )
604c
605c print *, "r,s,t",r(1),s(1),t(1)
606c print *, "rr,ss,tt",rr(1),ss(1),tt(1)
607c
608C-----------------------------------------------
609C calculation de Ni(-1<r<1 , -1<s<1 , -1<t<1)
610C-----------------------------------------------
611 CALL i10ni(llt,rr ,ss ,tt ,ni )
612C parity problem if convergence depends on mvsiz !!!!!!!
613C IF(CONV/=0)RETURN
614C
615 ENDDO
616 ENDDO
617C
618 DO i=1,llt
619 nx(i) = dydt(i)*dzdr(i) - dzdt(i)*dydr(i)
620 ny(i) = dzdt(i)*dxdr(i) - dxdt(i)*dzdr(i)
621 nz(i) = dxdt(i)*dydr(i) - dydt(i)*dxdr(i)
622 ENDDO
623C
624 RETURN
subroutine i10rstn(llt, rr, ss, tt, ni, conv, drdx, drdy, drdz, dsdx, dsdy, dsdz, dtdx, dtdy, dtdz, xx, yy, zz, r, s, t)
Definition i10lagm.F:712
subroutine i10deri(llt, rr, ss, tt, ni, drdx, drdy, drdz, dsdx, dsdy, dsdz, dtdx, dtdy, dtdz, dxdr, dydr, dzdr, dxdt, dydt, dzdt, xx, yy, zz)
Definition i10lagm.F:791
subroutine i10ni(llt, rr, ss, tt, ni)
Definition i10lagm.F:632

◆ i10rstn()

subroutine i10rstn ( integer llt,
rr,
ss,
tt,
ni,
integer conv,
drdx,
drdy,
drdz,
dsdx,
dsdy,
dsdz,
dtdx,
dtdy,
dtdz,
xx,
yy,
zz,
r,
s,
t )

Definition at line 708 of file i10lagm.F.

712C-----------------------------------------------
713C I m p l i c i t T y p e s
714C-----------------------------------------------
715c#include "implicit_f.inc"
716 implicit none
717C-----------------------------------------------
718C G l o b a l P a r a m e t e r s
719C-----------------------------------------------
720#include "mvsiz_p.inc"
721#include "constant.inc"
722C-----------------------------------------------
723C D u m m y A r g u m e n t s
724C-----------------------------------------------
725 INTEGER LLT,CONV
726 my_real
727 . r(mvsiz),s(mvsiz),t(mvsiz),ni(mvsiz,7) ,
728 . rr(mvsiz),ss(mvsiz),tt(mvsiz),
729 . xx(mvsiz,7) ,yy(mvsiz,7) ,zz(mvsiz,7) ,
730 . drdx(mvsiz),drdy(mvsiz),drdz(mvsiz),
731 . dsdx(mvsiz),dsdy(mvsiz),dsdz(mvsiz),
732 . dtdx(mvsiz),dtdy(mvsiz),dtdz(mvsiz)
733C-----------------------------------------------
734C L o c a l V a r i a b l e s
735C-----------------------------------------------
736 INTEGER I
737 my_real
738 . dx ,dy,dz,dr ,ds,dt,err
739C
740 err=zero
741C-----------------------------------------------
742 DO i=1,llt
743C
744 dx = xx(i,7)
745 + - ni(i, 1)*xx(i, 1) - ni(i, 2)*xx(i, 2) - ni(i, 3)*xx(i, 3)
746 + - ni(i, 4)*xx(i, 4) - ni(i, 5)*xx(i, 5) - ni(i, 6)*xx(i, 6)
747 dy = yy(i,7)
748 + - ni(i, 1)*yy(i, 1) - ni(i, 2)*yy(i, 2) - ni(i, 3)*yy(i, 3)
749 + - ni(i, 4)*yy(i, 4) - ni(i, 5)*yy(i, 5) - ni(i, 6)*yy(i, 6)
750 dz = zz(i,7)
751 + - ni(i, 1)*zz(i, 1) - ni(i, 2)*zz(i, 2) - ni(i, 3)*zz(i, 3)
752 + - ni(i, 4)*zz(i, 4) - ni(i, 5)*zz(i, 5) - ni(i, 6)*zz(i, 6)
753C
754 dr = drdx(i)*dx + drdy(i)*dy + drdz(i)*dz
755 ds = dsdx(i)*dx + dsdy(i)*dy + dsdz(i)*dz
756 dt = dtdx(i)*dx + dtdy(i)*dy + dtdz(i)*dz
757C
758 rr(i) = rr(i) + dr
759 ss(i) = ss(i) + ds
760 tt(i) = tt(i) + dt
761C
762 r(i) = rr(i)
763 s(i) = ss(i)
764 t(i) = tt(i)
765C
766 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
767 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
768 err = max(err,abs(dr),abs(ds),abs(dt))
769 ELSE
770 rr(i) = max(min(rr(i),one),-one)
771 ss(i) = max(min(ss(i),one),-one)
772 tt(i) = max(min(tt(i),one),-one)
773 ENDIF
774c
775C
776 ENDDO
777C
778 IF(err<em4) conv = 1
779C-----------------------------------------------
780 RETURN
#define min(a, b)
Definition macros.h:20