OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lag_fxv.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine lag_fxv (ibfv, vel, skew, npf, tf, bll, iadll, lll, jll, sll, xll, comntag, icftag, jcftag, ms, in, v, vr, a, ar, iskip, ncf_s, nc, python, nodes)
subroutine lag_fxvp (ibfv, vel, skew, npf, tf, lagcomc, lagcomk, nc, nodglob, weight, ik, python, nodes)

Function/Subroutine Documentation

◆ lag_fxv()

subroutine lag_fxv ( integer, dimension(nifv,*) ibfv,
vel,
skew,
integer, dimension(*) npf,
tf,
bll,
integer, dimension(*) iadll,
integer, dimension(*) lll,
integer, dimension(*) jll,
integer, dimension(*) sll,
xll,
integer, dimension(*) comntag,
integer, dimension(*) icftag,
integer, dimension(*) jcftag,
ms,
in,
v,
vr,
a,
ar,
integer iskip,
integer ncf_s,
integer nc,
type(python_), intent(inout) python,
type(nodal_arrays_), intent(in) nodes )

Definition at line 35 of file lag_fxv.F.

40
41 USE python_funct_mod
42 USE python_call_funct_cload_mod
43 USE nodal_arrays_mod
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "param_c.inc"
52#include "com04_c.inc"
53#include "com08_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER NC, ISKIP, NCF_S,
58 . LLL(*),JLL(*),SLL(*),IADLL(*),IBFV(NIFV,*),NPF(*),
59 . COMNTAG(*),ICFTAG(*),JCFTAG(*)
60 my_real
61 . xll(*),bll(*),skew(lskew,*),vel(lfxvelr,*),tf(*),ms(*),in(*),
62 . v(3,*),vr(3,*),a(3,*),ar(3,*)
63 TYPE(PYTHON_), INTENT(INOUT) :: PYTHON
64 TYPE(nodal_arrays_), intent(in) :: NODES
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I, J, IC, N, K1, K2, K3, IK, ISK, IFUN, NNO, ISMOOTH
69 my_real
70 . ts, deri, vf, fac, facx, finter, finter_smooth
71 EXTERNAL finter, finter_smooth
72C-----------------------------------------------
73C NC : nombre de condition cinematique
74C IC : numero de la condition cinematique (1,NC)
75C IK :
76C I : numero global du noeud (1,NUMNOD)
77C J : direction 1,2,3,4,5,6
78C------
79C IADLL(NC) : IAD = IADLL(IC)
80C IK = IAD,IAD+1,IAD+2,...
81C LLL(LAG_NKF) : I = LLL(IK)
82C JLL(LAG_NKF) : J = JLL(IK)
83C======================================================================|
84 DO n=1,nfxvel
85 IF (ibfv(8,n)/=0) THEN
86 facx = vel(5,n)
87 ts = (tt + half*dt2)*facx
88 nno = iabs(ibfv(1,n))
89 isk = ibfv(2,n)/10
90 ifun= ibfv(3,n)
91 fac = vel(1,n)
92 j=ibfv(2,n)-10*isk
93!! VF = FINTER(IFUN, TS, NPF, TF, DERI)
94 ismooth = 0
95 IF (ifun > 0) ismooth = npf(2*nfunct+ifun+1)
96 IF (ismooth == 0) THEN
97 vf = finter(ifun, ts, npf, tf, deri)
98 ELSE IF (ismooth > 0) THEN
99 vf = finter_smooth(ifun, ts, npf, tf, deri)
100 ELSE
101 CALL python_call_funct_cload(python, -ismooth,ts, vf,nno,nodes)
102 ENDIF ! IF (ISMOOTH == 0)
103 nc = nc + 1
104 bll(nc) = -vf*fac / dt12
105 IF (isk<=1) THEN
106 iadll(nc+1)=iadll(nc) + 1
107 ik = iadll(nc)
108 lll(ik) = nno
109 jll(ik) = j
110 sll(ik) = 0
111 xll(ik) = one
112 ELSE
113 IF(j<=3)THEN
114 k1=3*j-2
115 k2=3*j-1
116 k3=3*j
117 iadll(nc+1)=iadll(nc) + 3
118 ik = iadll(nc)
119 lll(ik) = nno
120 jll(ik) = 1
121 sll(ik) = 0
122 xll(ik) = skew(k1,isk)
123 ik = ik + 1
124 lll(ik) = nno
125 jll(ik) = 2
126 sll(ik) = 0
127 xll(ik) = skew(k2,isk)
128 ik = ik + 1
129 lll(ik) = nno
130 jll(ik) = 3
131 sll(ik) = 0
132 xll(ik) = skew(k3,isk)
133 ELSE
134 j = j - 3
135 k1=3*j-2
136 k2=3*j-1
137 k3=3*j
138 ik = iadll(nc)
139 lll(ik) = nno
140 jll(ik) = 4
141 sll(ik) = 0
142 xll(ik) = skew(k1,isk)
143 ik = ik + 1
144 lll(ik) = nno
145 jll(ik) = 5
146 sll(ik) = 0
147 xll(ik) = skew(k2,isk)
148 ik = ik + 1
149 lll(ik) = nno
150 jll(ik) = 6
151 sll(ik) = 0
152 xll(ik) = skew(k3,isk)
153 ENDIF
154 ENDIF
155 ic = nc - ncf_s
156 icftag(ic) = ic + iskip
157 jcftag(ic+iskip) = nc
158 ENDIF
159 ENDDO
160C---
161 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ lag_fxvp()

subroutine lag_fxvp ( integer, dimension(nifv,*) ibfv,
vel,
skew,
integer, dimension(*) npf,
tf,
lagcomc,
lagcomk,
integer nc,
integer, dimension(*) nodglob,
integer, dimension(*) weight,
integer ik,
type(python_), intent(inout) python,
type(nodal_arrays_), intent(in) nodes )

Definition at line 176 of file lag_fxv.F.

179 USE python_funct_mod
180 USE nodal_arrays_mod
181 use python_call_funct_cload_mod
182C-----------------------------------------------
183C I m p l i c i t T y p e s
184C-----------------------------------------------
185#include "implicit_f.inc"
186C-----------------------------------------------
187C C o m m o n B l o c k s
188C-----------------------------------------------
189#include "param_c.inc"
190#include "com04_c.inc"
191#include "com08_c.inc"
192C-----------------------------------------------
193C D u m m y A r g u m e n t s
194C-----------------------------------------------
195 INTEGER NC, IK,
196 . IBFV(NIFV,*),NPF(*), NODGLOB(*), WEIGHT(*)
197 my_real
198 . lagcomk(4,*),lagcomc(2,*),skew(lskew,*),vel(lfxvelr,*),
199 . tf(*)
200 TYPE(PYTHON_), INTENT(INOUT) :: PYTHON
201 TYPE(nodal_arrays_), intent(in) :: NODES
202C-----------------------------------------------
203C L o c a l V a r i a b l e s
204C-----------------------------------------------
205 INTEGER I, J, IC, N, K1, K2, K3, ISK, IFUN, NNO,ISMOOTH
206 my_real
207 . ts, deri, vf, fac, facx, finter, finter_smooth
208 EXTERNAL finter, finter_smooth
209 INTEGER :: node_id
210C-----------------------------------------------
211C NC : nombre de condition cinematique
212C IC : numero de la condition cinematique (1,NC)
213C IK :
214C I : numero global du noeud (1,NUMNOD)
215C J : direction 1,2,3,4,5,6
216C------
217C BLL => LAGCOMC(2)
218C IADLL => LAGCOMC(1)
219C LLL => LAGCOMK(1)
220C JLL => LAGCOMK(2)
221C SLL => LAGCOMK(3)
222C XLL => LAGCOMK(4)
223C======================================================================|
224 DO n=1,nfxvel
225 IF (ibfv(8,n)/=0) THEN
226 nno = iabs(ibfv(1,n))
227 node_id = nno
228 IF(weight(nno)==1) THEN ! une seule fois en SPMD
229C numerotation globale
230 facx = vel(5,n)
231 ts = (tt + half*dt2)*facx
232 nno = nodglob(nno)
233 isk = ibfv(2,n)/10
234 ifun= ibfv(3,n)
235 fac = vel(1,n)
236 j=ibfv(2,n)-10*isk
237 ismooth = 0
238 IF (ifun > 0) ismooth = npf(2*nfunct+ifun+1)
239!! VF = FINTER(IFUN, TS, NPF, TF, DERI)
240 IF (ismooth == 0) THEN
241 vf = finter(ifun, ts, npf, tf, deri)
242 ELSE IF(ismooth > 0) THEN
243 vf = finter_smooth(ifun, ts, npf, tf, deri)
244 ELSE
245 CALL python_call_funct_cload(python, -ismooth,ts, vf,node_id,nodes)
246 ENDIF
247 nc = nc + 1
248 lagcomc(2,nc) = -vf*fac / dt12
249 IF (isk<=1) THEN
250 lagcomc(1,nc)=1
251 ik = ik+1
252 lagcomk(1,ik) = nno
253 lagcomk(2,ik) = j
254 lagcomk(3,ik) = 0
255 lagcomk(4,ik) = one
256 ELSE
257 IF(j<=3)THEN
258 k1=3*j-2
259 k2=3*j-1
260 k3=3*j
261 lagcomc(1,nc)=3
262 ik = ik+1
263 lagcomk(1,ik) = nno
264 lagcomk(2,ik) = 1
265 lagcomk(3,ik) = 0
266 lagcomk(4,ik) = skew(k1,isk)
267 ik = ik + 1
268 lagcomk(1,ik) = nno
269 lagcomk(2,ik) = 2
270 lagcomk(3,ik) = 0
271 lagcomk(4,ik) = skew(k2,isk)
272 ik = ik + 1
273 lagcomk(1,ik) = nno
274 lagcomk(2,ik) = 3
275 lagcomk(3,ik) = 0
276 lagcomk(4,ik) = skew(k3,isk)
277 ELSE
278 j = j - 3
279 k1=3*j-2
280 k2=3*j-1
281 k3=3*j
282 ik = ik+1
283 lagcomk(1,ik) = nno
284 lagcomk(2,ik) = 4
285 lagcomk(3,ik) = 0
286 lagcomk(4,ik) = skew(k1,isk)
287 ik = ik + 1
288 lagcomk(1,ik) = nno
289 lagcomk(2,ik) = 5
290 lagcomk(3,ik) = 0
291 lagcomk(4,ik) = skew(k2,isk)
292 ik = ik + 1
293 lagcomk(1,ik) = nno
294 lagcomk(2,ik) = 6
295 lagcomk(3,ik) = 0
296 lagcomk(4,ik) = skew(k3,isk)
297 ENDIF
298 ENDIF
299C IC = NC - NCF_S
300C ICFTAG(IC) = IC + ISKIP
301C JCFTAG(IC+ISKIP) = NC
302 ENDIF
303 ENDIF
304 ENDDO
305C---
306 RETURN