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