OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
xini28.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ xini28()

subroutine xini28 ( integer nx,
integer nax1d,
integer nax2d,
integer nax3d,
xel,
vel,
vrel,
integer iout,
integer iprop,
integer imat,
integer, dimension(nx) ix,
integer ids,
mass,
xiner,
stifm,
stifr,
viscm,
viscr,
uvar,
integer nuvar,
uvarn,
integer nuvarn,
dte )

Definition at line 39 of file xini28.F.

44 USE message_mod
45C-------------------------------------------------------------------------
46C This subroutine initialize a multipurpose element
47C when element uses property TYPE28==NSTRAND.
48C----------+---------+---+---+--------------------------------------------
49C VAR | SIZE |TYP| RW| DEFINITION
50C----------+---------+---+---+--------------------------------------------
51C IOUT | 1 | I | R | OUTPUT FILE UNIT (L00 file)
52C IPROP | 1 | I | R | PROPERTY NUMBER
53C IMAT | 1 | I | R | MATERIAL NUMBER
54C----------+---------+---+---+--------------------------------------------
55C NX | 1 | I | R | NUMBER OF NODES
56C----------+---------+---+---+--------------------------------------------
57C XEL | 3*NX | F | R | NODES COORDINATES
58C VEL | 3*NX | F | R | NODES VELOCITIES
59C VREL | 3*NX | F | R | NODES ROTATIONAL VELOCITIES
60C----------+---------+---+---+--------------------------------------------
61C NAX1D | 1 | I | W | NUMBER OF EDGES TO BE DRAWN INTO ANIM
62C NAX2D | 1 | I | W | NUMBER OF FACETS TO BE DRAWN INTO ANIM
63C NAX3D | 1 | I | W | NUMBER OF SOLIDS TO BE DRAWN INTO ANIM
64C----------+---------+---+---+--------------------------------------------
65C IX | NX | I | R | ELEMENT CONNECTIVITY
66C | IX(J) (1<=J<=NX) : NODE J USER ID
67C IDS | 1 | I | R | ELEMENT USER IDENTIFIER
68C----------+---------+---+---+--------------------------------------------
69C MASS | NX | F | W | NODAL MASS
70C XINER | NX | F | W | NODAL INERTIA (SPHERICAL)
71C STIFM | NX | F | W | NODAL STIFNESS (TIME STEP)
72C STIFR | NX | F | W | NODAL ROTATION STIFNESS (TIME STEP)
73C VISCM | NX | F | W | NODAL VISCOSITY (TIME STEP)
74C VISCR | NX | F | W | NODAL ROTATION VISCOSITY (TIME STEP)
75C----------+---------+---+---+--------------------------------------------
76C UVAR |NUVAR | F | W | USER ELEMENT VARIABLES
77C NUVAR | 1 | I | R | NUMBER OF USER ELEMENT VARIABLES
78C UVARN |NUVARN*NX| F | W | USER ELEMENT VARIABLES
79C NUVARN | 1 | I | R | NUMBER OF USER ELEMENT VARIABLES PER NODE.
80C----------+---------+---+---+--------------------------------------------
81C DTE | 1 | F | W | MAXIMUM ELEMENT TIME STEP TO BE USED BY RADIOSS.
82C----------+---------+---+---+--------------------------------------------
83C-------------------------------------------------------------------------
84C FUNCTION
85C-------------------------------------------------------------------------
86C INTEGER II = GET_U_PNU(I,IP,KK)
87C IFUNCI = GET_U_PNU(I,IP,KFUNC)
88C IPROPI = GET_U_PNU(I,IP,KPROP)
89C IMATI = GET_U_PNU(I,IP,KMAT)
90C I : VARIABLE INDEX(1 for first variable,...)
91C IP : PROPERTY NUMBER
92C KK : PARAMETER KFUNC,KMAT,KPROP
93C THIS FUNCTION RETURN THE USER STORED FUNCTION(IF KK=KFUNC),
94C MATERIAL(IF KK=KMAT) OR PROPERTY(IF KK=KPROP) NUMBERS.
95C SEE LECG28 FOR CORRESPONDING ID STORAGE.
96C-------------------------------------------------------------------------
97C INTEGER IFUNCI = GET_U_MNU(I,IM,KFUNC)
98C I : VARIABLE INDEX(1 for first function)
99C IM : MATERIAL NUMBER
100C KFUNC : ONLY FUNCTION ARE YET AVAILABLE.
101C THIS FUNCTION RETURN THE USER STORED FUNCTION NUMBERS(function
102C referred by users materials).
103C SEE LECM28 FOR CORRESPONDING ID STORAGE.
104C-------------------------------------------------------------------------
105C my_real PARAMI = GET_U_GEO(I,IP)
106C I : PARAMETER INDEX(1 for first parameter,...)
107C IP : PROPERTY NUMBER
108C THIS FUNCTION RETURN THE USER GEOMETRY PARAMETERS
109C-------------------------------------------------------------------------
110C my_real PARAMI = GET_U_MAT(I,IM)
111C I : PARAMETER INDEX(1 for first parameter,...)
112C IM : MATERIAL NUMBER
113C THIS FUNCTION RETURN THE USER MATERIAL PARAMETERS
114C NOTE: GET_U_MAT(0,IMAT) RETURN THE DENSITY
115C-------------------------------------------------------------------------
116C INTEGER MID = GET_U_PID(IP)
117C IP : PROPERTY NUMBER
118C THIS FUNCTION RETURN THE USER PROPERTY ID CORRESPONDING TO
119C USER PROPERTY NUMBER IP.
120C-------------------------------------------------------------------------
121C INTEGER PID = GET_U_MID(IM)
122C IM : MATERIAL NUMBER
123C THIS FUNCTION RETURN THE USER MATERIAL ID CORRESPONDING TO
124C USER MATERIAL NUMBER IM.
125C-------------------------------------------------------------------------
126C-----------------------------------------------
127C I m p l i c i t T y p e s
128C-----------------------------------------------
129#include "implicit_f.inc"
130C-----------------------------------------------
131C A n a l y s e M o d u l e
132C-----------------------------------------------
133C----------------------------------------------------------
134C D u m m y A r g u m e n t s a n d F u n c t i o n
135C----------------------------------------------------------
136 INTEGER IOUT,NUVAR,NUVARN,IPROP,IMAT,
137 . NX ,NAX1D ,NAX2D ,NAX3D , IX(NX), IDS,
138 . GET_U_PNU,GET_U_PID,GET_U_MID,GET_U_MNU,
139 . KFUNC,KMAT,KPROP
140 my_real
141 . xel(3,nx),vel(3,nx),vrel(3,nx),
142 . mass(nx) ,xiner(nx) ,stifm(nx) ,
143 . stifr(nx),viscm(nx) ,viscr(nx) ,uvar(nuvar) ,
144 . uvarn(nuvarn*nx), dte,
145 . get_u_mat,get_u_geo,get_u_func,ffac
146 EXTERNAL get_u_pnu,get_u_mnu,get_u_mat,get_u_geo,get_u_pid,
147 . get_u_mid,get_u_func
148 parameter(kfunc=29)
149 parameter(kmat=31)
150 parameter(kprop=33)
151C=======================================================================
152C
153C EXAMPLE : NSTRAND.
154C
155C=======================================================================
156C-----------------------------------------------
157C L o c a l V a r i a b l e s
158C-----------------------------------------------
159 my_real
160 . ms,xk,xc,epstot,f,dfdx,rho,stif,deps,g,dgdx,l0,
161 . lprev, lnext,
162 . xm, xkm, xcm, fact, xn, dtc, dtk
163 INTEGER I,K,NB1,NB2,NB3,MB1,MB2,MB3,MB4,MB5,IFUNCT,IFV
164C-----------------------------------------------
165C POLYLINE TO DRAW INTO ANIM.
166 nax1d=nx-1
167 nax2d=0
168 nax3d=0
169C-----------------------------------------------
170C initial total length UVAR(NB1:NB1)
171 nb1=1
172C previous elongation UVAR(NB2:NB2)
173 nb2=nb1+1
174C previous force UVAR(NB3:NB3)
175 nb3=nb2+1
176C initial nodes masses UVARN(MB1:MB1+NX-1)
177 mb1=1
178C forces into strands UVARN(MB2:MB2+NX-1)
179C using UVARN(MB2:MB2+NX-2) only.
180 mb2=mb1+nx
181C strands initial length UVARN(MB3:MB3+NX-1)
182C using UVARN(MB3:MB3+NX-2) only.
183 mb3=mb2+nx
184C strands elongations UVARN(MB4:MB4+NX-1)
185C using UVARN(MB4:MB4+NX-2) only.
186 mb4=mb3+nx
187C strands internal energy UVARN(MB5:MB5+NX-1)
188C using UVARN(MB5:MB5+NX-2) only.
189 mb5=mb4+nx
190C-----------------------------------------------
191C ELEMENT CHECK
192 IF(nx<3)THEN
193C WRITE(IOUT,*)
194C . ' ** ERROR NSTRAND : LESS THAN 3 NODES, ELEMENT=',
195C . IDS
196 CALL ancmsg(msgid=381,
197 . msgtype=msgerror,
198 . anmode=aninfo,
199 . i1=ids)
200C IERR=IERR+1
201C GOTO 999
202 ENDIF
203C-------
204 rho =get_u_geo(3,iprop)
205C-------
206C POLYLINE LENGTH & NODES MASS.
207C-------
208 lprev=
209 . sqrt((xel(1,2)-xel(1,1))*(xel(1,2)-xel(1,1))
210 . +(xel(2,2)-xel(2,1))*(xel(2,2)-xel(2,1))
211 . +(xel(3,2)-xel(3,1))*(xel(3,2)-xel(3,1)))
212 uvar(nb1) =lprev
213 uvarn(mb3)=lprev
214C
215 mass(1) =half*rho*lprev
216 IF (lprev<=em15) THEN
217C WRITE(IOUT,*)
218C .' ** ERROR NSTRAND : NULL STRAND LENGTH, ELEMENT=',
219C . IDS
220C IERR=IERR+1
221C GOTO 999
222 CALL ancmsg(msgid=382,
223 . msgtype=msgerror,
224 . anmode=aninfo,
225 . i1=ids)
226 ENDIF
227 IF(mass(1)<=em15)THEN
228C WRITE(IOUT,*)
229C .' ** ERROR NSTRAND : NULL NODAL MASS, ELEMENT=',
230C . IDS
231C IERR=IERR+1
232C GOTO 999
233 CALL ancmsg(msgid=383,
234 . msgtype=msgerror,
235 . anmode=aninfo,
236 . i1=ids)
237 ENDIF
238 DO k=2,nx-1
239 lnext=
240 . sqrt((xel(1,k+1)-xel(1,k))*(xel(1,k+1)-xel(1,k))
241 . +(xel(2,k+1)-xel(2,k))*(xel(2,k+1)-xel(2,k))
242 . +(xel(3,k+1)-xel(3,k))*(xel(3,k+1)-xel(3,k)))
243 IF (lnext<=em15) THEN
244C WRITE(IOUT,*)
245C .' ** ERROR NSTRAND : NULL STRAND LENGTH, ELEMENT=',
246C . IDS
247C IERR=IERR+1
248C GOTO 999
249 CALL ancmsg(msgid=382,
250 . msgtype=msgerror,
251 . anmode=aninfo,
252 . i1=ids)
253 ENDIF
254 mass(k) = half*rho*(lprev+lnext)
255 uvarn(mb3+k-1)=lnext
256 uvar(nb1) =uvar(nb1)+lnext
257 IF(mass(k)<=em15)THEN
258C WRITE(IOUT,*)
259C .' ** ERROR NSTRAND : NULL NODAL MASS, ELEMENT=',
260C . IDS
261C IERR=IERR+1
262C GOTO 999
263 CALL ancmsg(msgid=383,
264 . msgtype=msgerror,
265 . anmode=aninfo,
266 . i1=ids)
267 ENDIF
268 lprev=lnext
269 ENDDO
270 mass(nx) = half*rho*lprev
271 IF(mass(nx)<=em15)THEN
272C WRITE(IOUT,*)
273C .' ** ERROR NSTRAND : NULL NODAL MASS, ELEMENT=',
274C . IDS
275C IERR=IERR+1
276C GOTO 999
277 CALL ancmsg(msgid=383,
278 . msgtype=msgerror,
279 . anmode=aninfo,
280 . i1=ids)
281 ENDIF
282C------------------------------------------
283 xk =get_u_geo(4,iprop)
284 dfdx=zero
285 ifunct=get_u_pnu(1,iprop,kfunc)
286C
287 xc =get_u_geo(5,iprop)
288 ifv=get_u_pnu(2,iprop,kfunc)
289 ffac=get_u_geo(12,iprop)
290C
291 IF (ifunct==0.AND.ifv==0) THEN
292C------------------------------------------
293C LINEAR ELASTIC
294 l0 =uvar(nb1)
295 stif=xk
296 f =zero
297 ELSEIF (ifunct==0.AND.ifv/=0) THEN
298C------------------------------------------
299C G(Deps) only.
300 l0 =uvar(nb1)
301 stif=zero
302 f =one
303 ELSE
304C------------------------------------------
305C NON LINEAR ELASTIC
306 l0 =uvar(nb1)
307 epstot=zero
308 f =get_u_func(ifunct,epstot,dfdx)
309 stif =ffac*dfdx
310 ENDIF
311C------------------------------------------
312 deps=zero
313 dgdx=zero
314 g =one
315 IF (ifv/=0) THEN
316 g=get_u_func(ifv,deps,dgdx)
317 stif=stif*g
318 ENDIF
319C-------
320C CHECK NSTRAND STIFNESS AND DAMPING.
321 IF( stif/uvar(nb1)<=em15
322 . .AND.(f*dgdx+xc)/uvar(nb1)<=em15)THEN
323C WRITE(IOUT,*)
324C .' ** ERROR NSTRAND : NULL NODAL STIFFNESS & DAMPING, ELEMENT=',
325C . IDS
326C IERR=IERR+1
327C GOTO 999
328 CALL ancmsg(msgid=384,
329 . msgtype=msgerror,
330 . anmode=aninfo,
331 . i1=ids)
332 ENDIF
333C-------
334C RETURN ELEMENT TIME STEP.
335 xn=nx
336 dte = ep20
337 DO k=1,nx-1
338 xm = rho*uvarn(mb3+k-1)
339C rigidite tangente
340C tous les brins ont la meme longueur correspond a :
341C XKM = STIF*(XN-1.)/L0
342 xkm = stif/uvarn(mb3+k-1)
343C tous les brins ont la meme longueur correspond a :
344C XCM = (F*DGDX+XC)*(XN-1.)/L0
345 xcm = (f*dgdx+xc)/uvarn(mb3+k-1)
346 IF(xcm+xkm<em15)xm =one
347 xkm= max(em15,xkm)
348C DTK=(SQRT(0.25*XCM*XCM+XM*XKM)-0.5*XCM)/MAX(EM15,XKM)
349C DTC=0.5 * 2.*XM/MAX(EM15,XCM)
350 dtk=(sqrt(xcm*xcm+xm*xkm)-xcm)/max(em15,xkm)
351 dtc=xm/max(em15,xcm)
352 IF (dtk==zero) THEN
353C XKM==0.
354 dtk=dtc
355 ELSE
356 dtk=min(dtk,dtc)
357 ENDIF
358 dte=min(dte,dtk)
359 ENDDO
360C-------
361C FOR NODAL TIME STEP COMPUTATION.
362 viscm(1) =(f*dgdx+xc)/uvarn(mb3)
363 stifm(1) =stif/uvarn(mb3)
364 DO k=2,nx-1
365 fact =one/uvarn(mb3+k-2) + one/uvarn(mb3+k-1)
366 stifm(k) =stif*fact
367 viscm(k) =(f*dgdx+xc)*fact
368 ENDDO
369 viscm(nx) =(f*dgdx+xc)/uvarn(mb3+nx-2)
370 stifm(nx) =stif/uvarn(mb3+nx-2)
371C-------
372 DO k=1,nx
373 xiner(k) = zero
374 stifr(k) = zero
375 viscr(k) = zero
376
377 ENDDO
378C-------
379 DO k=1,nx
380 uvarn(mb1+k-1)=mass(k)
381 ENDDO
382C-------
383 WRITE(iout,1000) ids,l0,rho*l0,stif/l0
384 1000 FORMAT(' NSTRAND ELEMENT CHECKING :',/,
385 . ' ------------------------ ',/,
386 . ' ELEMENT IDENTIFIER . . . .',i8/,
387 . ' TOTAL LENGTH . . . . . . .',e12.4/,
388 . ' MASS . . . . . . . . . . .',e12.4/,
389 . ' INITIAL GLOBAL STIFFNESS .',e12.4//)
390C-------
391 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
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
get_u_pid
integer function get_u_pid(ip)
Definition uaccess.F:626
get_u_pnu
integer function get_u_pnu(ivar, ip, k)
Definition uaccess.F:482
get_u_mid
integer function get_u_mid(im)
Definition uaccess.F:668
get_u_mnu
integer function get_u_mnu(ivar, im, k)
Definition uaccess.F:565