OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
animx.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr23_c.inc"
#include "param_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine animx (elbuf_tab, iparg, itab, x, kxx, ixx, ipartx, pm, geo, bufmat, bufgeo, uix, xusr, nfacptx, ixedge, ixfacet, ixsolid, inumx1, inumx2, inumx3, ioffx1, ioffx2, ioffx3, xmass1, xmass2, xmass3, xfunc1, xfunc2, xfunc3, nanim1d_l)

Function/Subroutine Documentation

◆ animx()

subroutine animx ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(*) itab,
x,
integer, dimension(nixx,*) kxx,
integer, dimension(*) ixx,
integer, dimension(*) ipartx,
pm,
geo,
bufmat,
bufgeo,
integer, dimension(*) uix,
xusr,
integer, dimension(3,*) nfacptx,
integer, dimension(2,*) ixedge,
integer, dimension(4,*) ixfacet,
integer, dimension(8,*) ixsolid,
integer, dimension(*) inumx1,
integer, dimension(*) inumx2,
integer, dimension(*) inumx3,
integer, dimension(*) ioffx1,
integer, dimension(*) ioffx2,
integer, dimension(*) ioffx3,
xmass1,
xmass2,
xmass3,
xfunc1,
xfunc2,
xfunc3,
integer nanim1d_l )

Definition at line 40 of file animx.F.

47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE message_mod
51 USE elbufdef_mod
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 "com01_c.inc"
60#include "com04_c.inc"
61#include "scr23_c.inc"
62#include "param_c.inc"
63#include "units_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER KXX(NIXX,*),IXX(*),
68 . IPARTX(*), UIX(*), NFACPTX(3,*),
69 . IPARG(NPARG,*), ITAB(*),
70 . INUMX1(*), INUMX2(*), INUMX3(*),
71 . IOFFX1(*), IOFFX2(*), IOFFX3(*),
72 . IXEDGE(2,*), IXFACET(4,*), IXSOLID(8,*),
73 . NANIM1D_L
74 my_real
75 . x(3,*), pm(npropm,*), geo(npropg,*),
76 . bufmat(*) ,bufgeo(*) ,
77 . xusr(3,*) ,
78 . xmass1(*), xmass2(*), xmass3(*),
79 . xfunc1(10,*), xfunc2(10,*), xfunc3(10,*)
80C
81 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85C REAL
86 my_real
87 . off, massele, eintele
88 INTEGER IPRT, NG, MYNEL, MYNFT, MYIAD, MYITY,
89 . I, J, K, IPROP, IMAT, NX,
90 . UID,
91 . IGTYP,NUVAR,NUVARN,
92 . L, NAX1D, NAX2D, NAX3D, NEDGE, NFACET, NSOLID,
93 . IADNOD, KVAR,KVARN
94 CHARACTER*40 MESS
95C
96 TYPE(G_BUFEL_) ,POINTER :: GBUF
97C-----------------------------------------------
98C E x t e r n a l F u n c t i o n s
99C-----------------------------------------------
100C REAL
101C-----------------------------------------------
102 DATA mess/'MULTI-PURPOSE ELEMENT DISCRETIZATION '/
103C-----------------------------------------------
104 nax1d=0
105 nax2d=0
106 nax3d=0
107C
108 DO iprt=1,npart
109 DO ng=1,ngroup
110 mynel =iparg(2,ng)
111 mynft =iparg(3,ng)
112 myiad =iparg(4,ng)
113 myity =iparg(5,ng)
114C
115 gbuf => elbuf_tab(ng)%GBUF
116C
117 IF (myity == 100) THEN
118 DO 150 i=1,mynel
119 j=i+mynft
120 IF (ipartx(j) /= iprt) GOTO 150
121C
122 imat =kxx(1,j)
123 iprop=kxx(2,j)
124 nx =kxx(3,j)
125C
126 igtyp = nint(geo(12,iprop))
127 nuvar = nint(geo(25,iprop))
128 nuvarn= nint(geo(35,iprop))
129 kvar = nuvar*(i-1)+1
130 kvarn = nuvarn*nx*(i-1)+1
131C-------
132C FILL COORDINATES.
133 CALL xcoor3(x ,kxx(1,j) ,ixx ,itab ,nx ,
134 2 uid ,uix ,xusr )
135 iadnod=kxx(4,j)
136 DO k=1,nx
137 uix(nx+k)=ixx(iadnod+k-1)
138 ENDDO
139C-------
140 CALL sav_buf_point(pm,1)
141 CALL sav_buf_point(bufmat,2)
142 CALL sav_buf_point(geo,3)
143 CALL sav_buf_point(bufgeo,4)
144C CALL SAV_BUF_POINT(NPC,5)
145C CALL SAV_BUF_POINT(PLD,6)
146C-------
147 nedge =0
148 nfacet =0
149 nsolid =0
150 off = gbuf%OFF(i)
151 eintele= gbuf%EINT(i)
152 massele= gbuf%MASS(i)
153cc OFF =ELBUF(NB1)
154cc EINTELE=ELBUF(NB2)
155cc MASSELE=ELBUF(NB3)
156 IF (igtyp == 28) THEN
157 CALL xanim28(nx ,uix ,uid ,xusr ,
158 2 iout ,iprop ,imat ,
159 3 off ,massele ,eintele ,
160 4 nedge , nfacet , nsolid ,
161 5 ixedge(1,nax1d+1), ixfacet(1,nax2d+1),ixsolid(1,nax3d+1),
162 6 xmass1(nax1d+1) , xmass2(nax2d+1) , xmass3(nax3d+1),
163 7 xfunc1(1,nax1d+1) ,xfunc2(1,nax2d+1) ,xfunc3(1,nax3d+1) ,
164 8 nuvar ,gbuf%VAR(kvar) ,nuvarn ,gbuf%VARN(kvarn))
165cc 8 NUVAR ,ELBUF(NB4) ,NUVARN ,ELBUF(NB5) )
166 ELSEIF (igtyp == 29) THEN
167 CALL xanim29(nx ,uix ,uid ,xusr ,
168 2 iout ,iprop ,imat ,
169 3 off ,massele ,eintele ,
170 4 nedge , nfacet , nsolid ,
171 5 ixedge(1,nax1d+1), ixfacet(1,nax2d+1),ixsolid(1,nax3d+1),
172 6 xmass1(nax1d+1) , xmass2(nax2d+1) , xmass3(nax3d+1),
173 7 xfunc1(1,nax1d+1) ,xfunc2(1,nax2d+1) ,xfunc3(1,nax3d+1) ,
174 8 nuvar ,gbuf%VAR(kvar) ,nuvarn ,gbuf%VARN(kvarn))
175cc 8 NUVAR ,ELBUF(NB4) ,NUVARN ,ELBUF(NB5) )
176 ELSEIF (igtyp == 30) THEN
177 CALL xanim30(nx ,uix ,uid ,xusr ,
178 2 iout ,iprop ,imat ,
179 3 off ,massele ,eintele ,
180 4 nedge , nfacet , nsolid ,
181 5 ixedge(1,nax1d+1), ixfacet(1,nax2d+1),ixsolid(1,nax3d+1),
182 6 xmass1(nax1d+1) , xmass2(nax2d+1) , xmass3(nax3d+1),
183 7 xfunc1(1,nax1d+1) ,xfunc2(1,nax2d+1) ,xfunc3(1,nax3d+1) ,
184 8 nuvar ,gbuf%VAR(kvar),nuvarn ,gbuf%VARN(kvarn))
185cc 8 NUVAR ,ELBUF(NB4) ,NUVARN ,ELBUF(NB5) )
186 ELSEIF (igtyp == 31) THEN
187 CALL xanim31(nx ,uix ,uid ,xusr ,
188 2 iout ,iprop ,imat ,
189 3 off ,massele ,eintele ,
190 4 nedge , nfacet , nsolid ,
191 5 ixedge(1,nax1d+1), ixfacet(1,nax2d+1),ixsolid(1,nax3d+1),
192 6 xmass1(nax1d+1) , xmass2(nax2d+1) , xmass3(nax3d+1),
193 7 xfunc1(1,nax1d+1) ,xfunc2(1,nax2d+1) ,xfunc3(1,nax3d+1) ,
194 8 nuvar ,gbuf%VAR(kvar),nuvarn ,gbuf%VARN(kvarn))
195cc 8 NUVAR ,ELBUF(NB4) ,NUVARN ,ELBUF(NB5) )
196 ENDIF
197C--------
198 nfacptx(1,iprt)=nfacptx(1,iprt)+nedge
199 nfacptx(2,iprt)=nfacptx(2,iprt)+nfacet
200 nfacptx(3,iprt)=nfacptx(3,iprt)+nsolid
201C--------
202 DO l=1,nedge
203 ioffx1(nax1d+l)=nint(min(gbuf%OFF(i),one))
204cc IOFFX1(NAX1D+L)=NINT(MIN(ELBUF(NB1),ONE))
205 inumx1(nax1d+l)=kxx(nixx,j)
206 ixedge(1,nax1d+l)=ixx(iadnod+ixedge(1,nax1d+l)-1)
207 ixedge(2,nax1d+l)=ixx(iadnod+ixedge(2,nax1d+l)-1)
208 ENDDO
209 DO l=1,nfacet
210 ioffx2(nax2d+l)=nint(min(gbuf%OFF(i),one))
211cc IOFFX2(NAX2D+L)=NINT(MIN(ELBUF(NB1),ONE))
212 inumx2(nax2d+l)=kxx(nixx,j)
213 ixfacet(1,nax2d+l)=ixx(iadnod+ixfacet(1,nax2d+l)-1)
214 ixfacet(2,nax2d+l)=ixx(iadnod+ixfacet(2,nax2d+l)-1)
215 ixfacet(3,nax2d+l)=ixx(iadnod+ixfacet(3,nax2d+l)-1)
216C if 3 nodes facet : node 4 should be equal to node 3.
217 ixfacet(4,nax2d+l)=ixx(iadnod+ixfacet(4,nax2d+l)-1)
218 ENDDO
219 DO l=1,nsolid
220 ioffx3(nax3d+l)=nint(min(gbuf%OFF(i),one))
221cc IOFFX3(NAX3D+L)=NINT(MIN(ELBUF(NB1),ONE))
222 inumx3(nax3d+l)=kxx(nixx,j)
223 ixsolid(1,nax3d+l)=ixx(iadnod+ixsolid(1,nax3d+l)-1)
224 ixsolid(2,nax3d+l)=ixx(iadnod+ixsolid(2,nax3d+l)-1)
225 ixsolid(3,nax3d+l)=ixx(iadnod+ixsolid(3,nax3d+l)-1)
226 ixsolid(4,nax3d+l)=ixx(iadnod+ixsolid(4,nax3d+l)-1)
227 ixsolid(5,nax3d+l)=ixx(iadnod+ixsolid(5,nax3d+l)-1)
228 ixsolid(6,nax3d+l)=ixx(iadnod+ixsolid(6,nax3d+l)-1)
229 ixsolid(7,nax3d+l)=ixx(iadnod+ixsolid(7,nax3d+l)-1)
230 ixsolid(8,nax3d+l)=ixx(iadnod+ixsolid(8,nax3d+l)-1)
231 ENDDO
232C--------
233 nax1d=nax1d+nedge
234 nax2d=nax2d+nfacet
235 nax3d=nax3d+nsolid
236 nanim1d_l = nax1d
237C123456789C123456789C123456789C123456789C123456789C123456789C123456789C1
238 IF (nax1d > nanim1d .OR. nax2d > nanim2d .OR.
239 . nax3d > nanim3d) THEN
240 CALL ancmsg(msgid=28,anmode=aninfo)
241 CALL arret(2)
242 ENDIF
243 150 CONTINUE
244 ENDIF ! IF (MYITY == 100)
245 ENDDO ! DO NG=1,NGROUP
246 ENDDO ! DO IPRT=1,NPART
247C----------------------------------
248C IF (IERR>0) THEN
249C WRITE(ISTDO,*)
250C . ' ** ERROR DISCRETIZATION OF MULTI-PURPOSE ELEMENTS.'
251C WRITE(IOUT,*)
252C . ' ** ERROR DISCRETIZATION OF MULTI-PURPOSE ELEMENTS.'
253C CALL ARRET(2)
254C ENDIF
255C----------------------------------
256 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
sav_buf_point
void sav_buf_point(int *buf, int *i)
Definition eng_callback_c.c:58
min
#define min(a, b)
Definition macros.h:20
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
arret
subroutine arret(nn)
Definition arret.F:87
xanim28
subroutine xanim28(nx, uix, uid, xel, iout, iprop, imat, off, massele, eintele, nedge, nfacet, nsolid, ixedge, ixfacet, ixsolid, xmassed, xmassfa, xmassso, xfunced, xfuncfa, xfuncso, nuvar, uvar, nuvarn, uvarn)
Definition xanim28.F:45
xanim29
subroutine xanim29(nx, uix, uid, xel, iout, iprop, imat, off, massele, eintele, nedge, nfacet, nsolid, ixedge, ixfacet, ixsolid, xmassed, xmassfa, xmassso, xfunced, xfuncfa, xfuncso, nuvar, uvar, nuvarn, uvarn)
Definition xanim29.F:41
xanim30
subroutine xanim30(nx, uix, uid, xel, iout, iprop, imat, off, massele, eintele, nedge, nfacet, nsolid, ixedge, ixfacet, ixsolid, xmassed, xmassfa, xmassso, xfunced, xfuncfa, xfuncso, nuvar, uvar, nuvarn, uvarn)
Definition xanim30.F:41
xanim31
subroutine xanim31(nx, uix, uid, xel, iout, iprop, imat, off, massele, eintele, nedge, nfacet, nsolid, ixedge, ixfacet, ixsolid, xmassed, xmassfa, xmassso, xfunced, xfuncfa, xfuncso, nuvar, uvar, nuvarn, uvarn)
Definition xanim31.F:41
xcoor3
subroutine xcoor3(x, kxx, ixx, itab, nx, uid, uix, xusr)
Definition xcoor3.F:31