OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lag_fxv.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!|| lag_fxv ../engine/source/tools/lagmul/lag_fxv.F
25!||--- called by ------------------------------------------------------
26!|| lag_mult ../engine/source/tools/lagmul/lag_mult.F
27!||--- calls -----------------------------------------------------
28!|| finter ../engine/source/tools/curve/finter.F
29!|| finter_smooth ../engine/source/tools/curve/finter_smooth.F
30!||--- uses -----------------------------------------------------
31!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
32!|| python_call_funct_cload_mod ../engine/source/loads/general/python_call_funct_cload.F90
33!|| python_funct_mod ../common_source/modules/python_mod.F90
34!||====================================================================
35 SUBROUTINE lag_fxv(IBFV ,VEL ,SKEW ,NPF ,TF ,
36 2 BLL ,IADLL ,LLL ,JLL ,SLL ,
37 3 XLL ,COMNTAG,ICFTAG ,JCFTAG ,MS ,
38 4 IN ,V ,VR ,A ,AR ,
39 5 ISKIP ,NCF_S ,NC ,PYTHON, nodes)
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
162 END
163C
164!||====================================================================
165!|| lag_fxvp ../engine/source/tools/lagmul/lag_fxv.F
166!||--- called by ------------------------------------------------------
167!|| lag_multp ../engine/source/tools/lagmul/lag_mult.f
168!||--- calls -----------------------------------------------------
169!|| finter ../engine/source/tools/curve/finter.F
170!|| finter_smooth ../engine/source/tools/curve/finter_smooth.F
171!||--- uses -----------------------------------------------------
172!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
173!|| python_call_funct_cload_mod ../engine/source/loads/general/python_call_funct_cload.f90
174!|| python_funct_mod ../common_source/modules/python_mod.F90
175!||====================================================================
176 SUBROUTINE lag_fxvp(IBFV ,VEL ,SKEW ,NPF ,TF ,
177 2 LAGCOMC,LAGCOMK,NC ,NODGLOB,WEIGHT ,
178 3 IK ,PYTHON,NODES)
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
307 END
lag_fxv
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)
Definition lag_fxv.F:40
lag_fxvp
subroutine lag_fxvp(ibfv, vel, skew, npf, tf, lagcomc, lagcomk, nc, nodglob, weight, ik, python, nodes)
Definition lag_fxv.F:179
lag_mult
subroutine lag_mult(ipari, x, a, wat, v, ms, in, vr, itask, wag, itab, ixs, ixs20, ixs16, igrnod, fani, fsav, skew, ar, lambda, lagbuf, ibcslag, ixs10, gjbufi, gjbufr, ibmpc, rbmpc, npbyl, lpbyl, ibfv, vel, npf, tf, newfront, icontact, rwbuf, lprw, nprw, rbyl, d, dr, kinet, nsensor, sensor_tab, intbuf_tab, h3d_data, igrbric, python, nodes)
Definition lag_mult.F:70
lag_multp
subroutine lag_multp(ipari, x, a, wat, v, ms, in, vr, wag, itab, ixs, ixs20, ixs16, fani, fsav, skew, ar, lambda, lagbuf, ibcslag, ixs10, gjbufi, gjbufr, ibmpc, rbmpc, npbyl, lpbyl, ibfv, vel, npf, tf, newfront, icontact, rwbuf, lprw, nprw, rbyl, d, dr, kinet, nodglob, weight, nbncl, nbikl, nbnodl, nbnodlr, fr_lagf, llagf, iad_elem, fr_elem, intbuf_tab, h3d_data, python, nodes)
Definition lag_mult.F:444