OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pressure_cyl.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "impl1_c.inc"
#include "parit_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine pressure_cyl (loads, table, nsensor, sensor_tab, iframe, dt1, x, v, acc, fext, h3d_data, cptreac, fthreac, nodreac, fsky, wfext)

Function/Subroutine Documentation

◆ pressure_cyl()

subroutine pressure_cyl ( type (loads_), intent(in) loads,
type (ttable), dimension(ntable), intent(in) table,
integer, intent(in) nsensor,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab,
integer, dimension(liskn,*), intent(in) iframe,
intent(in) dt1,
intent(in) x,
intent(in) v,
intent(inout) acc,
intent(inout) fext,
type (h3d_database), intent(in) h3d_data,
integer, intent(in) cptreac,
intent(inout) fthreac,
integer, dimension(numnod), intent(in) nodreac,
intent(inout) fsky,
double precision, intent(inout) wfext )

Definition at line 35 of file pressure_cyl.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
h3d_mod
Definition h3d_mod.F:308
table_mod
Definition table_mod.F:112
press_seg3
subroutine press_seg3(a, b, c, n1, dir, ifunc, table, xfacr, xfact, press)
Definition press_seg3.F:37