OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pressure_cyl.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!|| pressure_cyl ../engine/source/loads/general/load_pcyl/pressure_cyl.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| press_seg3 ../engine/source/loads/general/load_pcyl/press_seg3.F
29!||--- uses -----------------------------------------------------
30!|| h3d_mod ../engine/share/modules/h3d_mod.F
31!|| loads_mod ../common_source/modules/loads/loads_mod.F90
32!|| sensor_mod ../common_source/modules/sensor_mod.F90
33!|| table_mod ../engine/share/modules/table_mod.f
34!||====================================================================
35 SUBROUTINE pressure_cyl(
36 . LOADS ,TABLE ,NSENSOR ,SENSOR_TAB,IFRAME ,
37 . DT1 ,X ,V ,ACC ,FEXT ,
38 . H3D_DATA ,CPTREAC ,FTHREAC ,NODREAC ,FSKY ,
39 . WFEXT)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE h3d_mod
44 USE table_mod
45 USE sensor_mod
46 USE loads_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "param_c.inc"
55#include "com04_c.inc"
56#include "com06_c.inc"
57#include "scr14_c.inc"
58#include "scr16_c.inc"
59#include "impl1_c.inc"
60#include "parit_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER ,INTENT(IN) :: NSENSOR,CPTREAC
65 my_real ,INTENT(IN) :: DT1
66 INTEGER ,DIMENSION(NUMNOD) ,INTENT(IN) :: NODREAC
67 INTEGER ,DIMENSION(LISKN,*) ,INTENT(IN) :: IFRAME
68 my_real ,DIMENSION(8,LSKY) ,INTENT(INOUT) :: fsky
69 my_real ,DIMENSION(3,NUMNOD) ,INTENT(IN) :: x,v
70 my_real ,DIMENSION(3,NUMNOD) ,INTENT(INOUT) :: acc,fext
71 my_real ,DIMENSION(6,CPTREAC),INTENT(INOUT) :: fthreac
72 TYPE (TTABLE) ,DIMENSION(NTABLE) ,INTENT(IN) :: TABLE
73 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
74 TYPE (LOADS_) ,INTENT(IN) :: LOADS
75 TYPE (H3D_DATABASE),INTENT(IN) :: H3D_DATA
76 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER :: I,J,IAD,IANIM,ISENS,IFUN,IFRA,N1,N2,N3,N4,M1,M2,
81 . NSEG,NDIM,NPOINT
82 my_real :: LEN,DIRX,DIRY,DIRZ,
83 . RMAX,XFACR,XFACT,YFAC,
84 . nx,ny,nz,fx,fy,fz,segp,press,wfextt
85 my_real, DIMENSION(3) :: p0,dir,a,b,c,d,m
86c=======================================================================
87 wfextt = zero
88 ianim = anim_v(5) + outp_v(5) + h3d_data%N_VECT_FINT
89 . + anim_v(6) + outp_v(6) + h3d_data%N_VECT_FEXT
90
91c
92 DO i = 1,loads%NLOAD_CYL
93 isens = loads%LOAD_CYL(i)%ISENS
94 IF (isens > 0) THEN
95 IF (sensor_tab(isens)%STATUS == 0) cycle
96 END IF
97c
98 nseg = loads%LOAD_CYL(i)%NSEG
99 ifra = loads%LOAD_CYL(i)%IFRAME + 1
100 xfacr= loads%LOAD_CYL(i)%XSCALE_R
101 xfact= loads%LOAD_CYL(i)%XSCALE_T
102 yfac = loads%LOAD_CYL(i)%YSCALE
103 ifun = loads%LOAD_CYL(i)%ITABLE
104 ndim = table(ifun)%NDIM
105 npoint = SIZE(table(ifun)%X(1)%VALUES)
106 rmax = table(ifun)%X(1)%VALUES(npoint)
107 m1 = iframe(1,ifra)
108 m2 = iframe(2,ifra)
109 dirx = x(1,m1) - x(1,m2)
110 diry = x(2,m1) - x(2,m2)
111 dirz = x(3,m1) - x(3,m2)
112 len = sqrt(dirx**2 + diry**2 + dirz**2)
113 ! SEGP beam axis
114 dir(1) = dirx / len
115 dir(2) = diry / len
116 dir(3) = dirz / len
117 p0(1) = x(1,m2)
118 p0(2) = x(2,m2)
119 p0(3) = x(3,m2)
120 DO j = 1,nseg
121 press = zero
122 n1 = loads%LOAD_CYL(i)%SEGNOD(j,1)
123 n2 = loads%LOAD_CYL(i)%SEGNOD(j,2)
124 n3 = loads%LOAD_CYL(i)%SEGNOD(j,3)
125 n4 = loads%LOAD_CYL(i)%SEGNOD(j,4)
126 a(1) = x(1,n1)
127 a(2) = x(2,n1)
128 a(3) = x(3,n1)
129 b(1) = x(1,n2)
130 b(2) = x(2,n2)
131 b(3) = x(3,n2)
132 c(1) = x(1,n3)
133 c(2) = x(2,n3)
134 c(3) = x(3,n3)
135c
136 IF (n4 == 0) THEN ! 3 node segment
137 CALL press_seg3(a ,b ,c ,p0 ,dir ,
138 . ifun ,table ,xfacr ,xfact ,segp )
139 nx = (c(2)-a(2))*(c(3)-b(3)) - (c(3)-a(3))*(c(2)-b(2))
140 ny = (c(3)-a(3))*(c(1)-b(1)) - (c(1)-a(1))*(c(3)-b(3))
141 nz = (c(1)-a(1))*(c(2)-b(2)) - (c(2)-a(2))*(c(1)-b(1))
142 press = segp * one_over_6
143 press = press * yfac
144 fx = press * nx
145 fy = press * ny
146 fz = press * nz
147 wfextt = wfextt
148 . + (fx*(v(1,n1) + v(1,n2) + v(1,n3))
149 . + fy*(v(2,n1) + v(2,n2) + v(2,n3))
150 . + fz*(v(3,n1) + v(3,n2) + v(3,n3))) * dt1
151c
152 ELSE ! 4 node segment
153 d(1) = x(1,n4)
154 d(2) = x(2,n4)
155 d(3) = x(3,n4)
156 m(1) = (x(1,n1) + x(1,n2) + x(1,n3) + x(1,n4)) * fourth
157 m(2) = (x(2,n1) + x(2,n2) + x(2,n3) + x(2,n4)) * fourth
158 m(3) = (x(3,n1) + x(3,n2) + x(3,n3) + x(3,n4)) * fourth
159c 1st internal triangle
160 CALL press_seg3(a ,b ,m ,p0 ,dir ,
161 . ifun ,table ,xfacr ,xfact ,segp )
162 press = press + segp * fourth
163c 2nd internal triangle
164 CALL press_seg3(b ,c ,m ,p0 ,dir ,
165 . ifun ,table ,xfacr ,xfact ,segp )
166 press = press + segp * fourth
167c 3rd internal triangle
168 CALL press_seg3(c ,d ,m ,p0 ,dir ,
169 . ifun ,table ,xfacr ,xfact ,segp )
170 press = press + segp * fourth
171c 4th internal triangle
172 CALL press_seg3(d ,a ,m ,p0 ,dir ,
173 . ifun ,table ,xfacr ,xfact ,segp )
174 press = press + segp * fourth
175c normal to segment = vector prod of 2 diagonals
176 nx = (c(2)-a(2))*(d(3)-b(3)) - (c(3)-a(3))*(d(2)-b(2))
177 ny = (c(3)-a(3))*(d(1)-b(1)) - (c(1)-a(1))*(d(3)-b(3))
178 nz = (c(1)-a(1))*(d(2)-b(2)) - (c(2)-a(2))*(d(1)-b(1))
179 press = abs(press) * yfac * one_over_8
180 fx = press * nx
181 fy = press * ny
182 fz = press * nz
183 wfextt = wfextt
184 . + (fx*(v(1,n1) + v(1,n2) + v(1,n3) + v(1,n4))
185 . + fy*(v(2,n1) + v(2,n2) + v(2,n3) + v(2,n4))
186 . + fz*(v(3,n1) + v(3,n2) + v(3,n3) + v(3,n4))) * dt1
187 END IF ! seg 4 node
188c-------------------------------------
189c Accelerations
190c-------------------------------------
191 IF (iparit == 0) THEN
192 acc(1,n1) = acc(1,n1) + fx
193 acc(2,n1) = acc(2,n1) + fy
194 acc(3,n1) = acc(3,n1) + fz
195 acc(1,n2) = acc(1,n2) + fx
196 acc(2,n2) = acc(2,n2) + fy
197 acc(3,n2) = acc(3,n2) + fz
198 acc(1,n3) = acc(1,n3) + fx
199 acc(2,n3) = acc(2,n3) + fy
200 acc(3,n3) = acc(3,n3) + fz
201 IF (n4 > 0) THEN
202 acc(1,n4) = acc(1,n4) + fx
203 acc(2,n4) = acc(2,n4) + fy
204 acc(3,n4) = acc(3,n4) + fz
205 END IF
206 ELSE
207 iad = loads%LOAD_CYL(i)%SEGMENT_ADRESS(1,j) ! get the adress in the fsky array for N1
208 fsky(1,iad) = fx
209 fsky(2,iad) = fy
210 fsky(3,iad) = fz
211c
212 iad = loads%LOAD_CYL(i)%SEGMENT_ADRESS(2,j) ! get the adress in the fsky array for N2
213 fsky(1,iad) = fx
214 fsky(2,iad) = fy
215 fsky(3,iad) = fz
216c
217 iad = loads%LOAD_CYL(i)%SEGMENT_ADRESS(3,j) ! get the adress in the fsky array for N3
218 fsky(1,iad) = fx
219 fsky(2,iad) = fy
220 fsky(3,iad) = fz
221c
222 IF (n4 > 0) THEN
223 iad = loads%LOAD_CYL(i)%SEGMENT_ADRESS(4,j) ! get the adress in the fsky array for N4
224 fsky(1,iad) = fx
225 fsky(2,iad) = fy
226 fsky(3,iad) = fz
227 END IF
228 END IF
229c
230 IF (ianim > 0) THEN
231 fext(1,n1) = fext(1,n1) + fx
232 fext(2,n1) = fext(2,n1) + fy
233 fext(3,n1) = fext(3,n1) + fz
234 fext(1,n2) = fext(1,n2) + fx
235 fext(2,n2) = fext(2,n2) + fy
236 fext(3,n2) = fext(3,n2) + fz
237 fext(1,n3) = fext(1,n3) + fx
238 fext(2,n3) = fext(2,n3) + fy
239 fext(3,n3) = fext(3,n3) + fz
240 IF (n4 > 0) THEN
241 fext(1,n4) = fext(1,n4) + fx
242 fext(2,n4) = fext(2,n4) + fy
243 fext(3,n4) = fext(3,n4) + fz
244 ENDIF
245 ENDIF
246 IF (cptreac > 0) THEN
247 IF (nodreac(n1) > 0) THEN
248 fthreac(1,nodreac(n1)) = fthreac(1,nodreac(n1)) + fx*dt1
249 fthreac(2,nodreac(n1)) = fthreac(2,nodreac(n1)) + fy*dt1
250 fthreac(3,nodreac(n1)) = fthreac(3,nodreac(n1)) + fz*dt1
251 ENDIF
252 IF (nodreac(n2) > 0) THEN
253 fthreac(1,nodreac(n2)) = fthreac(1,nodreac(n2)) + fx*dt1
254 fthreac(2,nodreac(n2)) = fthreac(2,nodreac(n2)) + fy*dt1
255 fthreac(3,nodreac(n2)) = fthreac(3,nodreac(n2)) + fz*dt1
256 ENDIF
257 IF (nodreac(n3) > 0) THEN
258 fthreac(1,nodreac(n3)) = fthreac(1,nodreac(n3)) + fx*dt1
259 fthreac(2,nodreac(n3)) = fthreac(2,nodreac(n3)) + fy*dt1
260 fthreac(3,nodreac(n3)) = fthreac(3,nodreac(n3)) + fz*dt1
261 ENDIF
262 IF (n4 > 0) THEN
263 IF (nodreac(n4) > 0) THEN
264 fthreac(1,nodreac(n4)) = fthreac(1,nodreac(n4)) + fx*dt1
265 fthreac(2,nodreac(n4)) = fthreac(2,nodreac(n4)) + fy*dt1
266 fthreac(3,nodreac(n4)) = fthreac(3,nodreac(n4)) + fz*dt1
267 ENDIF
268 ENDIF
269 ENDIF
270c
271 END DO ! NSEG
272 END DO ! 1,NLOAD_CYL
273c--------------------
274c external forces
275c--------------------
276 wfext = wfext + wfextt
277c-----------
278 RETURN
279 END
280
subroutine press_seg3(a, b, c, n1, dir, ifunc, table, xfacr, xfact, press)
Definition press_seg3.F:37
subroutine pressure_cyl(loads, table, nsensor, sensor_tab, iframe, dt1, x, v, acc, fext, h3d_data, cptreac, fthreac, nodreac, fsky, wfext)