OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i14ela.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i14ela (x, ksurf, igrsurf, bufsf, nsc, ksc, nsp, ksp, ksi, impact, cimp, nimp, stfac, nlo, gapmin, npc, pld, wf, stf)

Function/Subroutine Documentation

◆ i14ela()

subroutine i14ela ( x,
integer ksurf,
type (surf_), dimension(nsurf) igrsurf,
bufsf,
integer nsc,
ksc,
integer nsp,
ksp,
integer, dimension(*) ksi,
integer, dimension(*) impact,
cimp,
nimp,
stfac,
integer nlo,
gapmin,
integer, dimension(*) npc,
pld,
wf,
stf )

Definition at line 30 of file i14ela.F.

34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE groupdef_mod
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 "com04_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER NSC, NSP, KSURF,KSI(*),
54 . IMPACT(*), NLO, NPC(*)
55C REAL
56 my_real
57 . bufsf(*),ksc(*) ,ksp(*) ,stfac , gapmin,
58 . x(3,*) , cimp(3,*),nimp(3,*),pld(*),wf(*) ,
59 . stf
60 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER ADRBUF, I, IL, IN
65 INTEGER NDEB, NREST
66 INTEGER DGR
67 INTEGER IPT,NPT,II,JJ
68 my_real
69 . a, b, c, an, bn, cn, rot(9),
70 . x1, x2, x3, n1, n2, n3, n,
71 . xpvn1, ypvn1, zpvn1, sgnxn, sgnyn, sgnzn,
72 . ep, ans, ansmx, pente, ftot,
73 . fnormx, fnormy, fnormz, nf
74 my_real
75 . xpv(3,mvsiz)
76C-----------------------------------------------
77 adrbuf=igrsurf(ksurf)%IAD_BUFR
78 ftot = zero
79C-----------------------------------------------
80 a =bufsf(adrbuf+1)
81 b =bufsf(adrbuf+2)
82 c =bufsf(adrbuf+3)
83 dgr=bufsf(adrbuf+36)
84 an=a**dgr
85 bn=b**dgr
86 cn=c**dgr
87 an=one/an
88 bn=one/bn
89 cn=one/cn
90 DO i=1,9
91 rot(i)=bufsf(adrbuf+7+i-1)
92 END DO
93C-----------------------------------------------
94 ansmx=0.
95C-------------------------------
96C POINTS JUSTE IMPACTES.
97C-------------------------------
98 ndeb =0
99 nrest=nsc
100 50 CONTINUE
101C-------------------------------
102C Passage au repere local :
103C-------------------------------
104 DO i=1,min(mvsiz,nrest)
105 il=ksc(i+ndeb)
106 in=ksi(il)
107 x1=x(1,in)-bufsf(adrbuf+4)
108 x2=x(2,in)-bufsf(adrbuf+5)
109 x3=x(3,in)-bufsf(adrbuf+6)
110 xpv(1,i)=rot(1)*x1+rot(2)*x2+rot(3)*x3
111 xpv(2,i)=rot(4)*x1+rot(5)*x2+rot(6)*x3
112 xpv(3,i)=rot(7)*x1+rot(8)*x2+rot(9)*x3
113 ENDDO
114C-------------------------------
115C Normale et penetration.
116C-------------------------------
117#include "vectorize.inc"
118 DO i=1,min(mvsiz,nrest)
119 il=ksc(i+ndeb)
120 in=ksi(il)
121C-------------------------------
122 xpvn1 =xpv(1,i)**(dgr-1)
123 sgnxn=-one
124 IF (xpvn1*xpv(1,i)>=zero) sgnxn=one
125 ypvn1 =xpv(2,i)**(dgr-1)
126 sgnyn=-one
127 IF (ypvn1*xpv(2,i)>=zero) sgnyn=one
128 zpvn1 =xpv(3,i)**(dgr-1)
129 sgnzn=-one
130 IF (zpvn1*xpv(3,i)>=zero) sgnzn=one
131C-------------------------------
132 n1 =sgnxn*xpvn1*an
133 n2 =sgnyn*ypvn1*bn
134 n3 =sgnzn*zpvn1*cn
135 n =n1*n1+n2*n2+n3*n3
136 n =sqrt(n)
137C-------------------------------
138 ep=n1*xpv(1,i)+n2*xpv(2,i)+n3*xpv(3,i)
139C-------------------------------
140C Detection exacte de l'impact.
141C-------------------------------
142C Ellipsoide ::
143C ANS=(EP-SQRT(EP))/MAX(EM20,N)
144C Hyper-Ellipsoide ::
145 ans=(ep-exp((dgr-1)*log(max(ep,em20))/dgr))
146 . / max(exp((dgr-1)*log(em20)/dgr),n)
147C-------------------------------
148C projection du point impacte :
149C projection sur tangente / hors ellips.
150C-------------------------------
151 IF (gapmin<ans) THEN
152 impact(il)=0
153 ELSE
154 impact(il)=1
155 END IF
156 n1 =n1/max(em20,n)
157 n2 =n2/max(em20,n)
158 n3 =n3/max(em20,n)
159 cimp(1,il)=xpv(1,i)-ans*n1
160 cimp(2,il)=xpv(2,i)-ans*n2
161 cimp(3,il)=xpv(3,i)-ans*n3
162 nimp(1,il)=n1
163 nimp(2,il)=n2
164 nimp(3,il)=n3
165C-------------------------------
166 ans=gapmin-ans
167 ans=max(zero,ans)
168C-------------------------------
169 IF (ans>ansmx) ansmx=ans
170C-------------------------------
171 wf(in)=ans
172 ENDDO
173C---------------------------------
174 IF (nrest-mvsiz>0) THEN
175 nrest=nrest-mvsiz
176 ndeb =ndeb +mvsiz
177 GOTO 50
178 ENDIF
179C-------------------------------
180C POINTS PRECEDEMMENT IMPACTES.
181C-------------------------------
182 ndeb =0
183 nrest=nsp
184 100 CONTINUE
185C-------------------------------
186C Penetration max :
187C-------------------------------
188#include "vectorize.inc"
189 DO i=1,min(mvsiz,nrest)
190 il=ksp(i+ndeb)
191 in=ksi(il)
192C-------------------------------
193C penetration.
194C-------------------------------
195 ans=gapmin-wf(in)
196C-------------------------------
197C IF (GAPMIN<ANS) THEN
198C IMPACT(IL)=0
199C ELSE
200C IMPACT(IL)=1
201C END IF
202C ANS=MAX(ZERO,ANS)
203 IF (ans>ansmx) ansmx=ans
204C-------------------------------
205 wf(in)=ans
206 ENDDO
207C---------------------------------
208 IF (nrest-mvsiz>0) THEN
209 nrest=nrest-mvsiz
210 ndeb =ndeb +mvsiz
211 GOTO 100
212 ENDIF
213C-----------------------------------------------
214C FORCE ELASTIQUE TOTALE=FCT(PENETRATION MAX.).
215C-----------------------------------------------
216 IF (nlo/=0) THEN
217 npt = (npc(nlo+1)-npc(nlo))/2
218 ii = npc(nlo)
219 IF (ansmx<=pld(ii)) THEN
220 pente=(pld(ii+3)-pld(ii+1))/(pld(ii+2)-pld(ii))
221 ftot =pld(ii+1)+pente*(ansmx-pld(ii))
222 ELSEIF (ansmx>=pld(ii+2*(npt-1))) THEN
223 jj=ii+2*(npt-1)
224 pente=(pld(jj+1)-pld(jj-1))/(pld(jj)-pld(jj-2))
225 ftot =pld(jj+1)+max(-pld(jj+1),pente*(ansmx-pld(jj)))
226 ELSE
227 DO ipt=1,npt-1
228 IF (pld(ii)<=ansmx
229 . .AND.ansmx<=pld(ii+2)) THEN
230 pente=(pld(ii+3)-pld(ii+1))/(pld(ii+2)-pld(ii))
231 ftot =pld(ii+1)+pente*(ansmx-pld(ii))
232 GOTO 200
233 ENDIF
234 ii=ii+2
235 ENDDO
236 200 CONTINUE
237 ENDIF
238 ENDIF
239C-----------------------------------------------
240C RAIDEUR DE L'INTERFACE
241C TQ | SOMME DES FORCES | = F(PENETRATION MAX.)
242C-----------------------------------------------
243 IF (nlo/=0) THEN
244 fnormx=zero
245 fnormy=zero
246 fnormz=zero
247 DO i=1,nsc
248 il=ksc(i)
249 in=ksi(il)
250 fnormx=fnormx+wf(in)*nimp(1,il)
251 fnormy=fnormy+wf(in)*nimp(2,il)
252 fnormz=fnormz+wf(in)*nimp(3,il)
253 ENDDO
254C------
255 DO i=1,nsp
256 il=ksp(i)
257 in=ksi(il)
258 fnormx=fnormx+wf(in)*nimp(1,il)
259 fnormy=fnormy+wf(in)*nimp(2,il)
260 fnormz=fnormz+wf(in)*nimp(3,il)
261 ENDDO
262C------
263 nf =sqrt(fnormx*fnormx+fnormy*fnormy+fnormz*fnormz)
264 IF (nf/=zero) THEN
265 stf=stfac*ftot/nf
266 ELSE
267 stf=zero
268 ENDIF
269 ELSE
270 stf=stfac
271 ENDIF
272C-----------------------------------------------
273 DO i=1,nsc
274 il=ksc(i)
275 in=ksi(il)
276 wf(in)=stf*wf(in)
277 ENDDO
278C-----------------------------------------------
279 DO i=1,nsp
280 il=ksp(i)
281 in=ksi(il)
282 wf(in)=stf*wf(in)
283 ENDDO
284C------------------------------------------------------------
285 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:662