OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i8lagm.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 i8lagm (x, v, lll, jll, sll, xll, candn, cande, i_stok, ixs, iadll, eminx, nsv, nelem, n_mul_mx, itask, a, itied, nint, nkmax, comntag)
subroutine i8lll (llt, lll, jll, sll, xll, v, xx, yy, zz, iii, iadll, n_mul_mx, a, x, itied, nint, nkmax, comntag)
subroutine i8rst (llt, r, s, t, ni, nx, ny, nz, xx, yy, zz)
subroutine i8ni (llt, rr, ss, tt, ni)
subroutine i8rstn (llt, rr, ss, tt, ni, conv, drdx, drdy, drdz, dsdx, dsdy, dsdz, dtdx, dtdy, dtdz, xx, yy, zz, r, s, t)
subroutine i8deri (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

◆ i8deri()

subroutine i8deri ( 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 777 of file i8lagm.F.

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

◆ i8lagm()

subroutine i8lagm ( 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(*) 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 30 of file i8lagm.F.

35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C G l o b a l P a r a m e t e r s
41C-----------------------------------------------
42#include "mvsiz_p.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "task_c.inc"
47#include "com04_c.inc"
48#include "com08_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER I_STOK,N_MUL_MX,ITASK,ITIED,NINT,NKMAX ,
53 . LLL(*),JLL(*),SLL(*),CANDN(*),CANDE(*),COMNTAG(*),
54 . IXS(NIXS,*),IADLL(*),NSV(*) ,NELEM(*)
55C REAL
56 my_real
57 . x(3,*),v(3,*),xll(*),
58 . eminx(6,*),a(3,*)
59C-----------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I,J,K,IK,IE,IS,IC,NK,III(MVSIZ,9),LLT,NFT,LE,FIRST,LAST,
63 . I8
64 my_real
65 . xx(mvsiz,9),yy(mvsiz,9),zz(mvsiz,9),
66 . aa,xmin,ymin,zmin,xmax,ymax,zmax,dist
67C-----------------------------------------------
68C
69C
70C | M | Lt| | a | M ao
71C |---+---| | = |
72C | L | 0 | | la | bo
73C
74C [M] a + [L]t la = [M] ao
75C [L] a = bo
76C
77C a = -[M]-1[L]t la + ao
78C [L][M]-1[L]t la = [L] ao - bo
79C
80C on pose:
81C [H] = [L][M]-1[L]t
82C b = [L] ao - bo
83C
84C [H] la = b
85C
86C a = ao - [M]-1[L]t la
87C-----------------------------------------------
88C
89C la : LAMBDA(NC)
90C ao : A(NUMNOD)
91C L : XLL(NK,NC)
92C M : MAS(NUMNOD)
93C [L][M]-1[L]t la : HLA(NC)
94C [L] ao - b : B(NC)
95C [M]-1[L]t la : LTLA(NUMNOD)
96C
97C NC : nombre de contact
98C NK : nombre de noeud pour un contact (8+1,16+1,8+8,16+16)
99C
100C IC : numero du contact (1,NC)
101C IK : numero de noeud local a un contact (1,NK)
102C I : numero global du noeud (1,NUMNOD)
103C
104C IADLL(NC) : IAD = IADLL(IC)
105C LLL(NC*(9,27)) : I = LLL(IAD+1,2...IADNEXT-1)
106C-----------------------------------------------
107C evaluation de b:
108C
109C Vs = Somme(Ni Vi)
110C Vs_ + dt As = Somme(Ni Vi_) + Somme(dt Ni Ai)
111C Somme(dt Ni Ai) - dt As = Vs_ -Somme(Ni Vi_)
112C [L] = dt {N1,N2,..,N15,-1}
113C bo = [L] a = -[L]/dt v_
114C b = [L] ao - bo
115C b = [L] ao + [L]/dt v_ = [L] (v_ + ao dt)/dt
116C-----------------------------------------------
117C b = [L] vo+/dt + vout
118C-----------------------------------------------
119C-----------------------------------------------------------------------
120C boucle sur les candidats au contact
121C-----------------------------------------------------------------------
122 first = 1 + i_stok * itask / nthread
123 last = i_stok*(itask+1) / nthread
124 llt = 0
125 nft=llt+1
126 DO ic=first,last
127 le = cande(ic)
128 ie = nelem(le)
129C-----------------------------------------------------------------------
130C test si shell 16
131C-----------------------------------------------------------------------
132 IF(ie.ge .1.AND.ie.le .numels8)THEN
133 is = nsv(candn(ic))
134 dist = -ep30
135 dist = max(eminx(1,le)-x(1,is)-dt2*(v(1,is)+dt12*a(1,is)),
136 . x(1,is)+dt2*(v(1,is)+dt12*a(1,is))-eminx(4,le),dist)
137 dist = max(eminx(2,le)-x(2,is)-dt2*(v(2,is)+dt12*a(2,is)),
138 . x(2,is)+dt2*(v(2,is)+dt12*a(2,is))-eminx(5,le),dist)
139 dist = max(eminx(3,le)-x(3,is)-dt2*(v(3,is)+dt12*a(3,is)),
140 . x(3,is)+dt2*(v(3,is)+dt12*a(3,is))-eminx(6,le),dist)
141C-----------------------------------------------------------------------
142C test si dans la boite
143C-----------------------------------------------------------------------
144 IF(dist.le .zero)THEN
145c
146c print *, "dans la boite",XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX
147c
148 llt = llt+1
149 iii(llt,9)=is
150 xx(llt,9)=x(1,is)
151 yy(llt,9)=x(2,is)
152 zz(llt,9)=x(3,is)
153 DO k=1,8
154 iii(llt,k)=ixs(k+1,ie)
155 i = iii(llt,k)
156 xx(llt,k)=x(1,i)
157 yy(llt,k)=x(2,i)
158 zz(llt,k)=x(3,i)
159 ENDDO
160c
161c print *, "XX(1,1),XX(1,9)",XX(1,1),XX(1,9)
162c
163C-----------------------------------------------------------------------
164C calcul de [L] par paquet de mvsiz
165C-----------------------------------------------------------------------
166 IF(llt==mvsiz-1)THEN
167 CALL i8lll(
168 1 llt ,lll ,jll ,sll ,xll ,v ,
169 2 xx ,yy ,zz ,iii ,iadll ,
170 3 n_mul_mx ,a ,x ,itied ,nint ,nkmax ,
171 4 comntag )
172 nft=llt+1
173 llt = 0
174 ENDIF
175 ELSE
176c debug
177 k=0
178 ENDIF
179 ENDIF
180 ENDDO
181C-----------------------------------------------------------------------
182C calcul de [L] pour dernier paquet
183C-----------------------------------------------------------------------
184 IF(llt/=0) CALL i8lll(
185 1 llt ,lll ,jll ,sll ,xll ,v ,
186 2 xx ,yy ,zz ,iii ,iadll ,
187 3 n_mul_mx ,a ,x ,itied ,nint ,nkmax ,
188 4 comntag )
189C
190C-----------------------------------------------
191 RETURN
i8lll
subroutine i8lll(llt, lll, jll, sll, xll, v, xx, yy, zz, iii, iadll, n_mul_mx, a, x, itied, nint, nkmax, comntag)
Definition i8lagm.F:208
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:272
max
#define max(a, b)
Definition macros.h:21

◆ i8lll()

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

Definition at line 204 of file i8lagm.F.

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

◆ i8ni()

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

Definition at line 628 of file i8lagm.F.

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

◆ i8rst()

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

Definition at line 502 of file i8lagm.F.

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

◆ i8rstn()

subroutine i8rstn ( 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 696 of file i8lagm.F.

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