OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
xinit3.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!|| xinit3 ../starter/source/elements/xelem/xinit3.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl2 ../starter/source/starter/freform.F
30!|| xini1u ../starter/source/elements/xelem/xinit3.F
31!|| xini28 ../starter/source/elements/xelem/xini28.F
32!|| xini29 ../starter/source/elements/xelem/xini29.F
33!|| xini2u ../starter/source/elements/xelem/xinit3.F
34!|| xini30 ../starter/source/elements/xelem/xini30.F
35!|| xini31 ../starter/source/elements/xelem/xini31.F
36!||--- uses -----------------------------------------------------
37!|| message_mod ../starter/share/message_module/message_mod.F
38!||====================================================================
39 SUBROUTINE xinit3(ELBUF_STR,KXX ,IXX ,X ,V ,
40 2 VR ,XMAS ,XIN ,
41 3 SKEW ,DTELEM ,NEL ,STIFN ,STIFR ,
42 4 PARTSAV ,IPARTX ,GEO ,
43 5 ITAB ,UIX ,XUSR ,VUSR ,
44 6 VRUSR ,UMASS ,UINER ,USTIFM ,USTIFR ,
45 7 UVISM ,UVISR ,IGEO ,NFT)
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE elbufdef_mod
50 USE message_mod
51 USE names_and_titles_mod , ONLY : nchartitle
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "param_c.inc"
60#include "com04_c.inc"
61#include "units_c.inc"
62#include "scr17_c.inc"
63#include "scr23_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER KXX(NIXX,*), IXX(*), IPARTX(*),ITAB(*),
68 . NEL, UIX(*),IGEO(NPROPGI,*), NFT
69C
70 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
71C
72 my_real
73 . x(3,*), v(*), vr(*), xmas(*), xin(*),
74 . skew(lskew,*), dtelem(*),stifn(*),stifr(*),partsav(20,*),
75 . geo(npropg,*),xusr(3,*), vusr(3,*),vrusr(3,*),
76 . umass(*) ,uiner(*) ,ustifm(*) ,ustifr(*) ,uvism(*) ,uvisr(*)
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER I, J, IGTYP, NDEPAR, I1,
81 . NUVAR, NUVARN, NUPARAM, IADBUF, NFUNC, IADFUN,
82 . NMAT,IADMAT,NJPID,IADPID,
83 . IADNOD, IMAT, IPROP, NX, K, UID,
84 . NAX1D, NAX2D, NAX3D,IPID1,KVAR,KVARN
85 INTEGER ID
86 CHARACTER(LEN=NCHARTITLE)::TITR
87C
88 my_real
89 . DT, DTC, XK, XC, XKR, XCR, XM, XINE, A,
90 . DTE, MASSELE
91C
92 TYPE(G_BUFEL_),POINTER :: GBUF
93C-----------------------------------------------
94 gbuf => elbuf_str%GBUF
95C---
96 ndepar=numelc+numels+numelt+numelq+numelp+numelr+numeltg
97 . +nft
98C-------
99 ipid1=kxx(2,nft+1)
100 id=igeo(1,ipid1)
101 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid1),ltitr)
102 DO i=1,nel
103 j=i+nft
104C
105 imat =kxx(1,j)
106 iprop=kxx(2,j)
107 nx =kxx(3,j)
108C
109 igtyp = nint(geo(12,iprop))
110 nuvar = nint(geo(25,iprop))
111 nuvarn= nint(geo(35,iprop))
112C
113 kvar = nuvar*(i-1)+1
114 kvarn = nuvarn*nx*(i-1)+1
115C-------
116 CALL xini1u(x ,v ,vr ,
117 2 gbuf%OFF(i) ,kxx(1,j),ixx ,itab ,nx ,
118 3 uid ,uix ,xusr ,vusr ,vrusr )
119C-------
120 nuparam = nint(geo(26,iprop))
121 iadbuf = nint(geo(27,iprop))
122C
123 IF (igtyp == 28) THEN
124 CALL xini28 (nx ,nax1d ,nax2d ,nax3d ,
125 1 xusr ,vusr ,vrusr ,
126 3 iout ,iprop ,imat ,
127 4 uix ,uid ,umass ,
128 5 uiner ,ustifm ,ustifr ,uvism ,uvisr ,
129 6 gbuf%VAR(kvar),nuvar ,gbuf%VARN(kvarn),nuvarn ,dte )
130 ELSEIF (igtyp == 29) THEN
131 dte=ep20
132 DO k=1,nx
133 umass(k)=zero
134 uiner(k)=zero
135 ustifm(k)=zero
136 ustifr(k)=zero
137 uvism(k)=zero
138 uvisr(k)=zero
139 ENDDO
140 nax1d=0
141 nax2d=0
142 nax3d=0
143 CALL xini29 (nx ,nax1d ,nax2d ,nax3d ,
144 1 xusr ,vusr ,vrusr ,
145 3 iout ,iprop ,imat ,
146 4 uix ,uid ,umass ,
147 5 uiner ,ustifm ,ustifr ,uvism ,uvisr ,
148 6 gbuf%VAR(kvar),nuvar ,gbuf%VARN(kvarn) ,nuvarn ,dte )
149 ELSEIF (igtyp == 30) THEN
150 dte=ep20
151 DO k=1,nx
152 umass(k)=zero
153 uiner(k)=zero
154 ustifm(k)=zero
155 ustifr(k)=zero
156 uvism(k)=zero
157 uvisr(k)=zero
158 ENDDO
159 nax1d=0
160 nax2d=0
161 nax3d=0
162 CALL xini30 (nx ,nax1d ,nax2d ,nax3d ,
163 1 xusr ,vusr ,vrusr ,
164 3 iout ,iprop ,imat ,
165 4 uix ,uid ,umass ,
166 5 uiner ,ustifm ,ustifr ,uvism ,uvisr ,
167 6 gbuf%VAR(kvar) ,nuvar ,gbuf%VARN(kvarn) ,nuvarn ,dte )
168 ELSEIF (igtyp == 31) THEN
169 dte=ep20
170 DO k=1,nx
171 umass(k)=zero
172 uiner(k)=zero
173 ustifm(k)=zero
174 ustifr(k)=zero
175 uvism(k)=zero
176 uvisr(k)=zero
177 ENDDO
178 nax1d=0
179 nax2d=0
180 nax3d=0
181 CALL xini31 (nx ,nax1d ,nax2d ,nax3d ,
182 1 xusr ,vusr ,vrusr ,
183 3 iout ,iprop ,imat ,
184 4 uix ,uid ,umass ,
185 5 uiner ,ustifm ,ustifr ,uvism ,uvisr ,
186 6 gbuf%VAR(kvar) ,nuvar ,gbuf%VARN(kvarn) ,nuvarn ,dte )
187 ELSE
188 CALL ancmsg(msgid=413,
189 . msgtype=msgerror,
190 . anmode=aninfo_blind_1,
191 . i1=kxx(5,k),
192 . c1='PROPERTY',
193 . i2=igeo(1,iprop),
194 . c2='PROPERTY',
195 . i3=igtyp)
196 ENDIF
197C-------
198C Total mass of elements
199 massele=zero
200 DO k=1,nx
201 massele=massele+umass(k)
202 ENDDO
203 gbuf%MASS(i) = massele
204C
205 nanim1d=nanim1d+nax1d
206 nanim2d=nanim2d+nax2d
207 nanim3d=nanim3d+nax3d
208C-------
209C Element time step
210 dtelem(ndepar+i)= dte
211C-------
212C Nodal time step is estimated based upon stiffness only, damping not taken into account
213 iadnod=kxx(4,j)
214 DO k=1,nx
215 i1=ixx(iadnod+k-1)
216 stifn(i1)=stifn(i1)+ustifm(k)
217 stifr(i1)=stifr(i1)+ustifr(k)
218 ENDDO
219C-------
220C Update nodal masses and global variables for TH
221 CALL xini2u(kxx(1,j),ixx,umass,uiner,xmas,
222 . xin,partsav,x,v,ipartx(j))
223 ENDDO ! DO I=1,NEL
224C------------------------------------------
225 RETURN
226 END
227!||====================================================================
228!|| xini1u ../starter/source/elements/xelem/xinit3.F
229!||--- called by ------------------------------------------------------
230!|| xinit3 ../starter/source/elements/xelem/xinit3.F
231!||====================================================================
232 SUBROUTINE xini1u(X ,V ,VR ,
233 2 OFF ,KXX ,IXX ,ITAB ,NX ,
234 3 UID ,UIX ,XUSR ,VUSR ,VRUSR )
235C
236C-----------------------------------------------
237C I m p l i c i t T y p e s
238C-----------------------------------------------
239#include "implicit_f.inc"
240C-----------------------------------------------
241C C o m m o n B l o c k s
242C-----------------------------------------------
243#include "scr23_c.inc"
244C-----------------------------------------------
245C D u m m y A r g u m e n t s
246C-----------------------------------------------
247 INTEGER KXX(NIXX),IXX(*),NX,ITAB(*),UIX(NX),UID
248C
249 my_real
250 . X(3,*),V(3,*),VR(3,*),OFF,
251 . XUSR(3,NX),VUSR(3,NX),VRUSR(3,NX)
252C
253C-----------------------------------------------
254C L o c a l V a r i a b l e s
255C-----------------------------------------------
256 INTEGER I, K, I1, IADNOD
257C-----------------------------------------------
258 off=one
259C
260 iadnod=kxx(4)
261 DO k=1,nx
262 i1=ixx(iadnod+k-1)
263 uix(k) =itab(i1)
264 xusr(1,k)=x(1,i1)
265 xusr(2,k)=x(2,i1)
266 xusr(3,k)=x(3,i1)
267 vusr(1,k)=v(1,i1)
268 vusr(2,k)=v(2,i1)
269 vusr(3,k)=v(3,i1)
270 vrusr(1,k)=vr(1,i1)
271 vrusr(2,k)=vr(2,i1)
272 vrusr(3,k)=vr(3,i1)
273 ENDDO
274 uid=kxx(5)
275C
276 RETURN
277 END
278!||====================================================================
279!|| xini2u ../starter/source/elements/xelem/xinit3.F
280!||--- called by ------------------------------------------------------
281!|| xinit3 ../starter/source/elements/xelem/xinit3.F
282!||====================================================================
283 SUBROUTINE xini2u(KXX,IXX,UMASS,UINER,MS,
284 . XIN,PARTSAV,X,V,IPART)
285C----------------------------------------------
286C-----------------------------------------------
287C I m p l i c i t T y p e s
288C-----------------------------------------------
289#include "implicit_f.inc"
290C-----------------------------------------------
291C C o m m o n B l o c k s
292C-----------------------------------------------
293#include "scr23_c.inc"
294C-----------------------------------------------
295C D u m m y A r g u m e n t s
296C-----------------------------------------------
297 INTEGER KXX(NIXX),IXX(*),IPART
298C
299 my_real
300 . UMASS(*), UINER(*), MS(*), XIN(*),X(3,*),V(3,*),
301 . PARTSAV(20,*)
302C-----------------------------------------------
303C L o c a l V a r i a b l e s
304C-----------------------------------------------
305 INTEGER I, K, IP, I1, NX, IADNOD
306C
307 my_real
308 . xx,yy,zz,xy,yz,zx
309 my_real
310 . ems, xi
311C----------------------------------------------
312 nx =kxx(3)
313 iadnod=kxx(4)
314C----------------------------------------------
315C Update nodal masses and part global variables
316 DO k=1,nx
317 i1 = ixx(iadnod+k-1)
318C
319 ems=umass(k)
320 ms(i1)=ms(i1)+ems
321 xi =uiner(k)
322 xin(i1)=xin(i1)+xi
323C
324 ip=ipart
325 partsav(1,ip)=partsav(1,ip) + ems
326 partsav(2,ip)=partsav(2,ip) + ems*x(1,i1)
327 partsav(3,ip)=partsav(3,ip) + ems*x(2,i1)
328 partsav(4,ip)=partsav(4,ip) + ems*x(3,i1)
329 xx = x(1,i1)*x(1,i1)
330 xy = x(1,i1)*x(2,i1)
331 yy = x(2,i1)*x(2,i1)
332 yz = x(2,i1)*x(3,i1)
333 zz = x(3,i1)*x(3,i1)
334 zx = x(3,i1)*x(1,i1)
335 partsav(5,ip) =partsav(5,ip) + xi + ems * (yy+zz)
336 partsav(6,ip) =partsav(6,ip) + xi + ems * (zz+xx)
337 partsav(7,ip) =partsav(7,ip) + xi + ems * (xx+yy)
338 partsav(8,ip) =partsav(8,ip) - ems * xy * half
339 partsav(9,ip) =partsav(9,ip) - ems * yz * half
340 partsav(10,ip)=partsav(10,ip) - ems * zx * half
341C
342 partsav(11,ip)=partsav(11,ip) + ems*v(1,i1)
343 partsav(12,ip)=partsav(12,ip) + ems*v(2,i1)
344 partsav(13,ip)=partsav(13,ip) + ems*v(3,i1)
345 partsav(14,ip)=partsav(14,ip) + half * ems *
346 . (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))
347 ENDDO
348C----------------------------------------------
349 RETURN
350 END
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
xini28
subroutine xini28(nx, nax1d, nax2d, nax3d, xel, vel, vrel, iout, iprop, imat, ix, ids, mass, xiner, stifm, stifr, viscm, viscr, uvar, nuvar, uvarn, nuvarn, dte)
Definition xini28.F:44
xini29
subroutine xini29(nx, nax1d, nax2d, nax3d, xel, vel, vrel, iout, iprop, imat, ix, ids, mass, xiner, stifm, stifr, viscm, viscr, uvar, nuvar, uvarn, nuvarn, dte)
Definition xini29.F:42
xini30
subroutine xini30(nx, nax1d, nax2d, nax3d, xel, vel, vrel, iout, iprop, imat, ix, ids, mass, xiner, stifm, stifr, viscm, viscr, uvar, nuvar, uvarn, nuvarn, dte)
Definition xini30.F:45
xini31
subroutine xini31(nx, nax1d, nax2d, nax3d, xel, vel, vrel, iout, iprop, imat, ix, ids, mass, xiner, stifm, stifr, viscm, viscr, uvar, nuvar, uvarn, nuvarn, dte)
Definition xini31.F:45
xinit3
subroutine xinit3(elbuf_str, kxx, ixx, x, v, vr, xmas, xin, skew, dtelem, nel, stifn, stifr, partsav, ipartx, geo, itab, uix, xusr, vusr, vrusr, umass, uiner, ustifm, ustifr, uvism, uvisr, igeo, nft)
Definition xinit3.F:46
xini2u
subroutine xini2u(kxx, ixx, umass, uiner, ms, xin, partsav, x, v, ipart)
Definition xinit3.F:285
xini1u
subroutine xini1u(x, v, vr, off, kxx, ixx, itab, nx, uid, uix, xusr, vusr, vrusr)
Definition xinit3.F:235