OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r4mat3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| r4mat3 ../engine/source/elements/spring/r4mat3.F
25!||--- called by ------------------------------------------------------
26!|| r4ke3 ../engine/source/elements/spring/r4ke3.F
27!||--- calls -----------------------------------------------------
28!|| rkenonl ../engine/source/elements/spring/r4mat3.F
29!||====================================================================
30 SUBROUTINE r4mat3(JFT ,JLT ,GEO ,KX ,MGN ,
31 1 AL0 ,FX ,DX ,TF ,NPF ,
32 2 POS ,IGEO )
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
93 END
94!||====================================================================
95!|| rkenonl ../engine/source/elements/spring/r4mat3.F
96!||--- called by ------------------------------------------------------
97!|| r12mat3 ../engine/source/elements/spring/r12mat3.F
98!|| r13mat3 ../engine/source/elements/spring/r13mat3.F
99!|| r4mat3 ../engine/source/elements/spring/r4mat3.F
100!||--- calls -----------------------------------------------------
101!|| es_func ../engine/source/elements/spring/r4mat3.F
102!|| vinter2 ../engine/source/tools/curve/vinter.F
103!|| vinter2dp ../engine/source/tools/curve/vinter.F
104!||====================================================================
105 SUBROUTINE rkenonl(JFT ,JLT ,KX ,FX ,DX ,
106 . IECROU ,IFUNC ,IFUNC2 ,A ,TF ,
107 . NPF ,POS )
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
190 END
191!||====================================================================
192!|| es_func ../engine/source/elements/spring/r4mat3.F
193!||--- called by ------------------------------------------------------
194!|| rkenonl ../engine/source/elements/spring/r4mat3.F
195!||====================================================================
196 SUBROUTINE es_func(IFUNCT ,TF ,NPF ,E_S )
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
281 END
max
#define max(a, b)
Definition macros.h:21
rkenonl
subroutine rkenonl(jft, jlt, kx, fx, dx, iecrou, ifunc, ifunc2, a, tf, npf, pos)
Definition r4mat3.F:108
r4mat3
subroutine r4mat3(jft, jlt, geo, kx, mgn, al0, fx, dx, tf, npf, pos, igeo)
Definition r4mat3.F:33
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