OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
forcefingeo.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!|| forcefingeo ../engine/source/loads/general/forcefingeo.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| finter ../engine/source/tools/curve/finter.F
29!|| finter_smooth ../engine/source/tools/curve/finter_smooth.F
30!|| sysfus2 ../engine/source/system/sysfus.F
31!||--- uses -----------------------------------------------------
32!|| h3d_mod ../engine/share/modules/h3d_mod.F
33!|| nodal_arrays_mod ../common_source/modules/nodal_arrays.F90
34!|| python_call_funct_cload_mod ../engine/source/loads/general/python_call_funct_cload.F90
35!|| python_funct_mod ../common_source/modules/python_mod.F90
36!|| sensor_mod ../common_source/modules/sensor_mod.F90
37!||====================================================================
38 SUBROUTINE forcefingeo(IBFV ,NPC ,TF ,A ,V ,X ,
39 2 VEL ,SENSOR_TAB,FSKY ,FEXT ,ITABM1,
40 3 H3D_DATA,NSENSOR, PYTHON,WFEXT,NODES)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE nodal_arrays_mod
45 USE python_funct_mod
46 use python_call_funct_cload_mod
47 USE h3d_mod
48 USE sensor_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53#include "param_c.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "com06_c.inc"
60#include "com08_c.inc"
61#include "impl1_c.inc"
62#include "scr14_c.inc"
63#include "scr16_c.inc"
64#include "parit_c.inc"
65C-----------------------------------------------
66C E x t e r n a l F u n c t i o n s
67C-----------------------------------------------
68 INTEGER SYSFUS2
69 my_real FINTER,FINTER_SMOOTH
70 EXTERNAL finter,finter_smooth
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 TYPE(nodal_arrays_) :: NODES
75 TYPE(PYTHON_), INTENT(inout) :: PYTHON
76 INTEGER ,INTENT(IN) :: NSENSOR
77 INTEGER IBFV(NIFV,*), NPC(*)
78 INTEGER ITABM1(*)
79 my_real tf(*), a(3,*), v(3,*), x(3,*),
80 . vel(lfxvelr,*),fsky(8,lsky),fext(3,*)
81 TYPE(h3d_database) :: H3D_DATA
82 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
83 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER N, N1, N2, K
88 INTEGER NCUR, NCUR_OLD, ISENS, ISMOOTH
89 my_real
90 . axi, aa, a0, vv, dydx, ts, ts_old,
91 . startt, stopt, facx, facy, f1, f2,
92 . xa, ya, za, xf, yf, zf,
93 . fac, skew1, skew2, skew3, wfextt
94C=======================================================================
95 wfextt = zero
96 ts_old = zero
97 ncur_old = 0
98C----------------------------------
99C CONCENTRATED FORCE
100C----------------------------------
101 DO n=1,nfxvel
102 IF (ibfv(13,n) /= 2) cycle
103 ncur = ibfv(15,n)
104 IF (ncur == 0) cycle
105 startt = vel(2,n)
106 stopt = vel(3,n)
107 IF(tt<startt) cycle
108 IF(tt>stopt ) cycle
109 n1 = iabs(ibfv(1,n))
110 n2 = ibfv(14,n)
111c N2 = SYSFUS2(N2,ITABM1,NUMNOD)
112 facx = vel(5,n)
113 facy = vel(8,n)
114C
115 isens=0
116 DO k=1,nsensor
117 IF(ibfv(4,n)==sensor_tab(k)%SENS_ID) isens=k
118 ENDDO
119 IF(isens==0)THEN
120 ts=tt
121 ELSE
122 ts = tt-sensor_tab(isens)%TSTART
123 IF(ts < zero) cycle
124 ENDIF
125C
126 IF(ncur_old/=ncur.OR.ts_old/=ts) THEN
127!! F1 = FINTER(NCUR,(TS-DT1)*FACX,NPC,TF,DYDX)
128!! F2 = FINTER(NCUR,TS*FACX,NPC,TF,DYDX)
129 ismooth = 0
130 IF (ncur > 0) ismooth = npc(2*nfunct+ncur+1)
131 IF (ismooth == 0) THEN
132 f1 = finter(ncur,(ts-dt1)*facx,npc,tf,dydx)
133 f2 = finter(ncur,ts*facx,npc,tf,dydx)
134 ELSE IF(ismooth > 0) THEN
135 f1 = finter_smooth(ncur,(ts-dt1)*facx,npc,tf,dydx)
136 f2 = finter_smooth(ncur,ts*facx,npc,tf,dydx)
137 ELSE IF(ismooth < 0) THEN
138 CALL python_call_funct_cload(python, -ismooth,ts-dt1, f1,n1,nodes)
139 CALL python_call_funct_cload(python, -ismooth,ts, f2,n2,nodes)
140 ENDIF ! IF (ISMOOTH == 0)
141 ncur_old = ncur
142 ts_old = ts
143 ENDIF
144C
145 a0 = facy*f1
146 aa = facy*f2
147C
148 IF(n2d/=1)THEN
149 axi=one
150 ELSE
151 axi=x(2,n2)
152 ENDIF
153C
154 xa = x(1,n1)
155 ya = x(2,n1)
156 za = x(3,n1)
157 xf = x(1,n2)
158 yf = x(2,n2)
159 zf = x(3,n2)
160 fac= sqrt((xf-xa)**2+(yf-ya)**2+(zf-za)**2)
161 IF(fac < vel(7,n)) cycle
162 skew1= (xf-xa)/fac
163 skew2= (yf-ya)/fac
164 skew3= (zf-za)/fac
165 vv = skew1*v(1,n2)+skew2*v(2,n2)+skew3*v(3,n2)
166 a(1,n2) = a(1,n2)+skew1*aa
167 a(2,n2) = a(2,n2)+skew2*aa
168 a(3,n2) = a(3,n2)+skew3*aa
169C
170 IF( anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT+
171 . anim_v(6)+outp_v(6)+h3d_data%N_VECT_FEXT > 0
172 . .AND.impl_s==0) THEN
173 fext(1,n2) = fext(1,n2)+skew1*aa
174 fext(2,n2) = fext(2,n2)+skew2*aa
175 fext(3,n2) = fext(3,n2)+skew3*aa
176 ENDIF
177 wfextt = wfextt + dt1*half*(a0+aa)*vv*axi
178 ENDDO
179C
180!$OMP ATOMIC
181 wfext = wfext + wfextt
182C
183 RETURN
184 END
forcefingeo
subroutine forcefingeo(ibfv, npc, tf, a, v, x, vel, sensor_tab, fsky, fext, itabm1, h3d_data, nsensor, python, wfext, nodes)
Definition forcefingeo.F:41
h3d_mod
Definition h3d_mod.F:308
h3d_mod::h3d_database
Definition h3d_mod.F:435