OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
xforc3.F File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine xforc3 (nft, nel, geo, pm, itab, kxx, ixx, x, v, vr, f, ar, ev, npc, pld, skew, dt2t, neltst, ityptst, stifn, stifr, ms, in, fskyi, isky, partsav, ipartx, bufmat, bufgeo, gresav, grth, igrth, elbuf_str, igre)

Function/Subroutine Documentation

◆ xforc3()

subroutine xforc3 ( integer nft,
integer nel,
geo,
pm,
integer, dimension(*) itab,
integer, dimension(nixx,*) kxx,
integer, dimension(*) ixx,
x,
v,
vr,
f,
ar,
ev,
integer, dimension(*) npc,
pld,
skew,
dt2t,
integer neltst,
integer ityptst,
stifn,
stifr,
ms,
in,
fskyi,
integer, dimension(*) isky,
partsav,
integer, dimension(*) ipartx,
bufmat,
bufgeo,
gresav,
integer, dimension(*) grth,
integer, dimension(*) igrth,
type (elbuf_struct_), target elbuf_str,
integer, intent(in) igre )

Definition at line 42 of file xforc3.F.

52C-----------------------------------------------
53C M o d u l e s
54C-----------------------------------------------
55 USE elbufdef_mod
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60#include "comlock.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "com08_c.inc"
65#include "param_c.inc"
66#include "parit_c.inc"
67#include "units_c.inc"
68#include "scr23_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER, INTENT(IN) :: IGRE
73 INTEGER NFT,NEL,KXX(NIXX,*),IXX(*), NPC(*),ISKY(*),
74 . IPARTX(*),NELTST ,ITYPTST,
75 . ITAB(*),GRTH(*),IGRTH(*)
76C REAL
77 my_real dt2t ,
78 . geo(npropg,*), pm(*), x(3,*),vr(3,*), v(3,*), f(3,*), ar(3,*),
79 . ev(*),pld(*),skew(lskew,*),fskyi(*),
80 . stifn(*),stifr(*),ms(*), in(*),partsav(*),
81 . bufmat(*),bufgeo(*) ,gresav(*)
82C
83 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87C REAL
89 . dt1u,
90 . dte, dtc, xkm, xcm, xkr, xcr, xm, xine, eusr
91 INTEGER I, J, K, IPROP, IMAT, ISENS, NX,
92 . NB1, NB2, NB3, NB4, NB5, NBFI, UID,
93 . IGTYP,NUVAR,NUVARN,NUPARAM,
94 . NISKYL,KEUSR,
95 . UIX(MAXNX),KVAR,KVARN
97 . xusr(3,maxnx),vusr(3,maxnx),vrusr(3,maxnx),umass(maxnx),
98 . uforc(3,maxnx),ustifm(maxnx), ustifr(maxnx), uvisr(maxnx),
99 . umomt(3,maxnx),uvism(maxnx),uiner(maxnx)
100C
101 TYPE(G_BUFEL_),POINTER :: GBUF
102C-----------------------------------------------
103 gbuf => elbuf_str%GBUF
104C
105 dt1u=dt1
106C------
107 DO i=1,nel
108 j=i+nft
109C
110 imat =kxx(1,j)
111 iprop=kxx(2,j)
112 nx =kxx(3,j)
113C
114 IF (iparit /= 0) THEN
115#include "lockon.inc"
116 niskyl = nisky
117 nisky = nisky + nx
118#include "lockoff.inc"
119 END IF
120C
121 igtyp = nint(geo(12,iprop))
122 nuvar = nint(geo(25,iprop))
123 nuvarn= nint(geo(35,iprop))
124C ISENS = NINT(GEO(45,IPROP))
125C
126cc NB1 =(I-1)*(3+NUVAR+NUVARN*NX)+1
127cc NB2 =NB1 +1
128cc NB3 =NB2 +1
129cc NB4 =NB3 +1
130cc NB5 =NB4 +NUVAR
131cc NBFI=NB5 +NUVARN*NX
132C
133 kvar = nuvar*(i-1)+1
134 kvarn = nuvarn*nx*(i-1)+1
135C-------
136C FILL COORDINATES.
137 CALL xcoor3(x ,kxx(1,j) ,ixx ,itab ,nx ,
138 2 uid ,uix ,xusr )
139C-------
140C FILL VELOCITIES.
141 CALL xdefo3(v ,vr ,kxx(1,j) ,ixx ,nx ,
142 2 vusr ,vrusr )
143C-------
144 CALL sav_buf_point(pm,1)
145 CALL sav_buf_point(bufmat,2)
146 CALL sav_buf_point(geo,3)
147 CALL sav_buf_point(bufgeo,4)
148 CALL sav_buf_point(npc,5)
149 CALL sav_buf_point(pld,6)
150C-------
151 IF (igtyp == 28) THEN
152C NSTRAND ELEMENTS.
153 keusr=0
154 eusr =zero
155 CALL xforc28(nx ,
156 2 xusr ,vusr ,vrusr ,uix ,uid ,
157 3 iout ,iprop ,imat ,gbuf%OFF(i) ,keusr ,
158 4 eusr ,umass ,uiner ,ustifm ,ustifr ,
159 5 uvism ,uvisr ,uforc ,umomt ,
160 6 nuvar ,gbuf%VAR(kvar) ,nuvarn ,gbuf%VARN(kvarn) ,dt1u , dte)
161 ELSEIF (igtyp == 29) THEN
162 keusr=0
163 eusr =zero
164 dte =ep20
165 DO k=1,nx
166 umass(k)=zero
167 uiner(k)=zero
168 ustifm(k)=zero
169 ustifr(k)=zero
170 uvism(k)=zero
171 uvisr(k)=zero
172 uforc(1,k)=zero
173 uforc(2,k)=zero
174 uforc(3,k)=zero
175 umomt(1,k)=zero
176 umomt(2,k)=zero
177 umomt(3,k)=zero
178 ENDDO
179 CALL xforc29(nx ,
180 2 xusr ,vusr ,vrusr ,uix ,uid ,
181 3 iout ,iprop ,imat ,gbuf%OFF(i) ,keusr ,
182 4 eusr ,umass ,uiner ,ustifm ,ustifr ,
183 5 uvism ,uvisr ,uforc ,umomt ,
184 6 nuvar ,gbuf%VAR(kvar) ,nuvarn ,gbuf%VARN(kvarn) ,dt1u , dte)
185 ELSEIF (igtyp == 30) THEN
186 keusr=0
187 eusr =zero
188 dte=ep20
189 DO k=1,nx
190 umass(k)=zero
191 uiner(k)=zero
192 ustifm(k)=zero
193 ustifr(k)=zero
194 uvism(k)=zero
195 uvisr(k)=zero
196 uforc(1,k)=zero
197 uforc(2,k)=zero
198 uforc(3,k)=zero
199 umomt(1,k)=zero
200 umomt(2,k)=zero
201 umomt(3,k)=zero
202 ENDDO
203 CALL xforc30(nx ,
204 2 xusr ,vusr ,vrusr ,uix ,uid ,
205 3 iout ,iprop ,imat ,gbuf%OFF(i) ,keusr ,
206 4 eusr ,umass ,uiner ,ustifm ,ustifr ,
207 5 uvism ,uvisr ,uforc ,umomt ,
208 6 nuvar ,gbuf%VAR(kvar) ,nuvarn ,gbuf%VARN(kvarn) ,dt1u , dte)
209 ELSEIF (igtyp == 31) THEN
210 keusr=0
211 eusr =zero
212 dte=ep20
213 DO k=1,nx
214 umass(k)=zero
215 uiner(k)=zero
216 ustifm(k)=zero
217 ustifr(k)=zero
218 uvism(k)=zero
219 uvisr(k)=zero
220 uforc(1,k)=zero
221 uforc(2,k)=zero
222 uforc(3,k)=zero
223 umomt(1,k)=zero
224 umomt(2,k)=zero
225 umomt(3,k)=zero
226 ENDDO
227 CALL xforc31(nx ,
228 2 xusr ,vusr ,vrusr ,uix ,uid ,
229 3 iout ,iprop ,imat ,gbuf%OFF(i) ,keusr ,
230 4 eusr ,umass ,uiner ,ustifm ,ustifr ,
231 5 uvism ,uvisr ,uforc ,umomt ,
232 6 nuvar ,gbuf%VAR(kvar) ,nuvarn ,gbuf%VARN(kvarn) ,dt1u , dte)
233 ENDIF ! IF (IGTYP == 28)
234C-------
235C CALCUL DE DT ELEMENTAIRE.
236 IF (gbuf%OFF(i) /= zero) THEN
237 IF (dte < dt2t) THEN
238 dt2t=dte
239 neltst =kxx(5,j)
240 ityptst=100
241 ENDIF
242 ELSE
243 DO k=1,nx
244 ustifr(k)=zero
245 ustifm(k)=zero
246 uvisr(k) =zero
247 uvism(k) =zero
248 uforc(1,k)=zero
249 uforc(2,k)=zero
250 uforc(3,k)=zero
251 umomt(1,k)=zero
252 umomt(2,k)=zero
253 umomt(3,k)=zero
254 ENDDO
255 ENDIF
256C-------
257 CALL xbilan3(
258 1 nx, kxx(1,j), ixx, x,
259 2 v, vr, umass, uiner,
260 3 uforc, umomt, keusr, eusr,
261 4 gbuf%EINT(i),partsav, ipartx(j), gresav,
262 5 grth, igrth(j), igre)
263C-------
264 IF (iparit == 0) THEN
265 CALL xcum3(nx,kxx(1,j),ixx,uforc ,ustifm,
266 2 uvism,ms, f, stifn )
267 ELSE
268 CALL xcum3p(nx,kxx(1,j),ixx,uforc ,ustifm,
269 2 uvism, ms, niskyl, fskyi ,isky)
270 ENDIF
271 ENDDO ! DO I=1,NEL
272C-----------------------------------------------
273 RETURN
#define my_real
Definition cppsort.cpp:32
void sav_buf_point(int *buf, int *i)
subroutine xbilan3(nx, kxx, ixx, x, v, vr, umass, uiner, forc, torq, keusr, eusr, eint, partsav, ipart, gresav, grth, igrth, igre)
Definition xbilan3.F:34
subroutine xcoor3(x, kxx, ixx, itab, nx, uid, uix, xusr)
Definition xcoor3.F:31
subroutine xcum3(nx, kxx, ixx, uforc, ustifm, uviscm, ms, f, stifn)
Definition xcum3.F:30
subroutine xcum3p(nx, kxx, ixx, uforc, ustifm, uviscm, ms, niskyl, fskyi, isky)
Definition xcum3.F:91
subroutine xdefo3(v, vr, kxx, ixx, nx, vusr, vrusr)
Definition xdefo3.F:30
subroutine xforc28(nx, xel, vel, vrel, uix, uid, iout, iprop, imat, off, keint, eint, mass, xiner, stifm, stifr, viscm, viscr, forc, torq, nuvar, uvar, nuvarn, uvarn, dt, dte)
Definition xforc28.F:45
subroutine xforc29(nx, xel, vel, vrel, uix, uid, iout, iprop, imat, off, keint, eint, mass, xiner, stifm, stifr, viscm, viscr, forc, torq, nuvar, uvar, nuvarn, uvarn, dt, dte)
Definition xforc29.F:41
subroutine xforc30(nx, xel, vel, vrel, uix, uid, iout, iprop, imat, off, keint, eint, mass, xiner, stifm, stifr, viscm, viscr, forc, torq, nuvar, uvar, nuvarn, uvarn, dt, dte)
Definition xforc30.F:41
subroutine xforc31(nx, xel, vel, vrel, uix, uid, iout, iprop, imat, off, keint, eint, mass, xiner, stifm, stifr, viscm, viscr, forc, torq, nuvar, uvar, nuvarn, uvarn, dt, dte)
Definition xforc31.F:41