OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r4mat3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "impl1_c.inc"
#include "scr05_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine r4mat3 (jft, jlt, geo, kx, mgn, al0, fx, dx, tf, npf, pos, igeo)
subroutine rkenonl (jft, jlt, kx, fx, dx, iecrou, ifunc, ifunc2, a, tf, npf, pos)
subroutine es_func (ifunct, tf, npf, e_s)

Function/Subroutine Documentation

◆ es_func()

subroutine es_func ( integer ifunct,
tf,
integer, dimension(*) npf,
e_s )

Definition at line 196 of file r4mat3.F.

197C-----------------------------------------------
198C I m p l i c i t T y p e s
199C-----------------------------------------------
200#include "implicit_f.inc"
201C-----------------------------------------------
202C D u m m y A r g u m e n t s
203C-----------------------------------------------
204 INTEGER NPF(*),IFUNCT
205C REAL
206 my_real
207 . tf(*),e_s
208C-----------------------------------------------
209C L o c a l V a r i a b l e s
210C-----------------------------------------------
211 INTEGER
212 . J,J1,NPOINT,N0
213 my_real
214 . x,y,y0,e1,e2,xn,yn
215C-----------------------------------------------
216 e_s = zero
217 npoint=(npf(ifunct+1)-npf(ifunct))/2+1
218 y0 = zero
219 n0 = 0
220 IF (tf(npf(ifunct))<zero) n0 = npoint+1
221 DO j=2,npoint
222 j1=2*(j-2)
223 x=tf(npf(ifunct)+j1)
224 IF (x>=zero) THEN
225 IF (x==zero) y0=tf(npf(ifunct)+j1+1)
226 n0=j
227 GOTO 10
228 ENDIF
229 ENDDO
230 10 CONTINUE
231C------only traction--------
232 IF (n0<=2) THEN
233 x=tf(npf(ifunct))
234 y=tf(npf(ifunct)+1)-y0
235 IF (x==zero) THEN
236 x=tf(npf(ifunct)+2)
237 y=tf(npf(ifunct)+3)-y0
238 ELSE
239 x=tf(npf(ifunct)+2)-x
240 y=tf(npf(ifunct)+3)-y
241 ENDIF
242 IF (abs(x)>zero) e_s= y/x
243C------only compression--------
244 ELSEIF (n0>=npoint) THEN
245 j1=2*(n0-3)
246 x=tf(npf(ifunct)+j1)
247 y=tf(npf(ifunct)+j1+1)-y0
248C------w/o zero point--------------
249 IF (n0==(npoint+1)) THEN
250 j1=2*(n0-4)
251 x=tf(npf(ifunct)+j1)-x
252 y=tf(npf(ifunct)+j1+1)-y
253 ENDIF
254 IF (abs(x)>zero) e_s= y/x
255 ELSE
256C------compression 1er point
257 j1=2*(n0-3)
258 xn=tf(npf(ifunct)+j1)
259 yn=tf(npf(ifunct)+j1+1)-y0
260 e1 = zero
261 IF (abs(xn)>zero) e1= yn/xn
262C------traction 1er point
263 j1=2*(n0-2)
264 x=tf(npf(ifunct)+j1)
265 IF (x==zero) THEN
266 j1=j1+2
267 x=tf(npf(ifunct)+j1)
268 y=tf(npf(ifunct)+j1+1)-y0
269 e2 = zero
270 IF (abs(x)>zero) e2= y/x
271 e_s= half*(e1+e2)
272C------w/o point (0,0)-----
273 ELSE
274 y=tf(npf(ifunct)+j1+1)-y0
275 e_s= zero
276 IF (abs(x-xn)>zero) e_s= (y-yn)/(x-xn)
277 ENDIF
278 ENDIF
279C
280 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ r4mat3()

subroutine r4mat3 ( integer jft,
integer jlt,
geo,
kx,
integer, dimension(*) mgn,
al0,
fx,
dx,
tf,
integer, dimension(*) npf,
pos,
integer, dimension(npropgi,*) igeo )

Definition at line 30 of file r4mat3.F.

33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C G l o b a l P a r a m e t e r s
39C-----------------------------------------------
40#include "mvsiz_p.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "param_c.inc"
45#include "impl1_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER JFT ,JLT, MGN(*),NPF(*),IGEO(NPROPGI,*)
50 my_real
51 . geo(npropg,*), kx(*),al0(*),fx(*),dx(*),tf(*),pos(*)
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER I,ILEN,ILENG
56 INTEGER IECROU(MVSIZ), IFUNC(MVSIZ),IFUNC2(MVSIZ)
57 my_real
58 . a(mvsiz)
59C-----------------------------------------------
60C
61 DO i=jft,jlt
62 kx(i)=geo(2,mgn(i))
63 ENDDO
64 ilen = 0
65 DO i=jft,jlt
66 a(i) =geo(10,mgn(i))
67C KX(I)=A(I)*KX(I)
68 ileng=nint(geo(93,mgn(i)))
69 IF(ileng/=0) ilen = 1
70 ENDDO
71 IF(ilen/=0) THEN
72 DO i=jft,jlt
73 ileng=nint(geo(93,mgn(i)))
74 IF(ileng/=0)THEN
75 kx(i)=kx(i)/al0(i)
76 ENDIF
77 ENDDO
78 ENDIF
79 IF (ismdisp>0.OR.isprn==1) THEN
80 DO i=jft,jlt
81 iecrou(i)=nint(geo(7,mgn(i)))
82C IFUNC(I) =NINT(GEO(4,MGN(I)))
83C IFUNC2(I) =NINT(GEO(18,MGN(I)))
84 ifunc(i) =igeo(101,mgn(i))
85 ifunc2(i)=igeo(103,mgn(i))
86 ENDDO
87 CALL rkenonl(jft ,jlt ,kx ,fx ,dx ,
88 . iecrou ,ifunc ,ifunc2 ,a ,tf ,
89 . npf ,pos )
90 ENDIF
91C
92 RETURN
rkenonl
subroutine rkenonl(jft, jlt, kx, fx, dx, iecrou, ifunc, ifunc2, a, tf, npf, pos)
Definition r4mat3.F:108

◆ rkenonl()

subroutine rkenonl ( integer jft,
integer jlt,
kx,
fx,
dx,
integer, dimension(*) iecrou,
integer, dimension(*) ifunc,
integer, dimension(*) ifunc2,
a,
tf,
integer, dimension(*) npf,
pos )

Definition at line 105 of file r4mat3.F.

108C-----------------------------------------------
109C I m p l i c i t T y p e s
110C-----------------------------------------------
111#include "implicit_f.inc"
112C-----------------------------------------------
113C G l o b a l P a r a m e t e r s
114C-----------------------------------------------
115#include "mvsiz_p.inc"
116#include "scr05_c.inc"
117#include "impl1_c.inc"
118#include "com01_c.inc"
119C-----------------------------------------------
120C D u m m y A r g u m e n t s
121C-----------------------------------------------
122 INTEGER JFT,JLT,NPF(*),IECROU(*), IFUNC(*),IFUNC2(*)
123 my_real
124 . fx(*), kx(*), dx(*), tf(*), pos(4,*),a(*)
125C-----------------------------------------------
126C L o c a l V a r i a b l e s
127C-----------------------------------------------
128 INTEGER
129 . I, J,JPOS(MVSIZ), JLEN(MVSIZ),JAD(MVSIZ),
130 . JPOS0(MVSIZ),JFUNC,JFUNC2,INDEX(MVSIZ),NC
131 my_real
132 . xx(mvsiz) ,dydx(mvsiz) ,yy(mvsiz),e_seg,e_t,e_min,
133 . x0(mvsiz),f0(mvsiz)
134C-------------------------------------
135C VECTOR INTERPOLATION (ADRESS)
136C-------------------------------------
137 nc = 0
138 IF (iline==1.OR.
139 . (ismdisp>0.AND.ncycle==1.AND.imconv==1)) THEN
140 DO i=jft,jlt
141 IF (ifunc(i)>0) THEN
142 nc = nc + 1
143 index(nc) = i
144 ENDIF
145 ENDDO
146 DO j=1,nc
147 i = index(j)
148 CALL es_func(ifunc(i),tf,npf,e_seg)
149 kx(i)= a(i)*max(em6,abs(e_seg))
150 ENDDO
151 ELSE
152 DO i=jft,jlt
153 IF (ifunc(i)>0.AND.iecrou(i)==0.AND.abs(dx(i))>em20) THEN
154 nc = nc + 1
155 index(nc) = i
156 ENDIF
157 ENDDO
158 IF (nc==0) RETURN
159C
160 DO j=1,nc
161 i = index(j)
162 jpos(j) = 0
163C JPOS(J) = NINT(POS(1,I))
164 jfunc=max(1,ifunc(i))
165 jad(j) = npf(jfunc) / 2 + 1
166 jlen(j) = npf(jfunc+1) / 2 - jad(j) - jpos(j)
167 xx(j) = dx(i)
168 jpos0(j) = jpos(j)
169 x0(j) = zero
170 ENDDO
171C
172 IF (iresp==1) THEN
173 CALL vinter2dp(tf,jad ,jpos0,jlen ,nc,x0 ,dydx ,f0)
174 CALL vinter2dp(tf,jad ,jpos ,jlen ,nc,xx ,dydx ,yy)
175 ELSE
176 CALL vinter2(tf,jad ,jpos0,jlen ,nc,x0 ,dydx ,f0 )
177 CALL vinter2(tf,jad ,jpos ,jlen ,nc,xx ,dydx ,yy )
178 ENDIF
179C
180 DO j=1,nc
181 i = index(j)
182 e_seg = abs((fx(i)-f0(j))/xx(j))
183 e_t = abs(dydx(j))
184 e_min = em06*kx(i)
185 kx(i)= a(i)*max(e_min,e_seg,e_t)
186 ENDDO
187 ENDIF
188C
189 RETURN
max
#define max(a, b)
Definition macros.h:21
es_func
subroutine es_func(ifunct, tf, npf, e_s)
Definition r4mat3.F:197
vinter2
subroutine vinter2(tf, iad, ipos, ilen, nel0, x, dydx, y)
Definition vinter.F:143
vinter2dp
subroutine vinter2dp(tf, iad, ipos, ilen, nel0, x, dydx, y)
Definition vinter.F:214