OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cfield.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "task_c.inc"
#include "param_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cfield_1 (python, icfield, fac, npc, tf, a, v, x, xframe, ms, sensor_tab, weight, ib, itask, iframe, nsensor, wfext)

Function/Subroutine Documentation

◆ cfield_1()

subroutine cfield_1 ( type(python_), intent(inout) python,
integer, dimension(sizfield,*) icfield,
fac,
integer, dimension(*) npc,
tf,
a,
v,
x,
xframe,
ms,
type (sensor_str_), dimension(nsensor), intent(in) sensor_tab,
integer, dimension(*) weight,
integer, dimension(*) ib,
integer itask,
integer, dimension(liskn,*) iframe,
integer, intent(in) nsensor,
double precision, intent(inout) wfext )

Definition at line 35 of file cfield.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE sensor_mod
42 USE python_funct_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47#include "comlock.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com04_c.inc"
52#include "com06_c.inc"
53#include "com08_c.inc"
54#include "task_c.inc"
55#include "param_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 TYPE(PYTHON_), INTENT(INOUT) :: PYTHON
60 INTEGER ,INTENT(IN) :: NSENSOR
61 INTEGER NPC(*)
62 INTEGER ICFIELD(SIZFIELD,*),IB(*),IFRAME(LISKN,*)
63 INTEGER WEIGHT(*),ITASK
64 my_real fac(lfacload,*), tf(*), a(3,*), v(3,*), ms(*),x(3,*), xframe(nxframe,*)
65 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
66 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER NL, N1, IFRA, N2, IFUNC, K1, K2, K3, ISENS,K,NN,IAD, J, PROC, IADF, IADL,IDIR,IFLAG,N1FRAM,IUN,JJ,IMOVFRAM
71 INTEGER :: IS_TABULATED
72 my_real nx, ny, nz, axi, a0, aa, vv, fx, fy, fz, ax, dydx, ts,
73 . gama, ma, vrot, x0, y0, z0, x1, y1, z1, x2, y2, z2, dwdt,
74 . wfextt,vmx,vmy,vmz,vrot2
75 my_real dist(3),arel(3),vn1fram(3),an1fram(3),dw(3)
76 my_real finter
77C-----------------------------------------------
78 EXTERNAL finter
79 DATA iun/1/
80C-----------------------------------------------
81
82 wfextt = zero
83 DO nl=1,nloadc
84 nn = icfield(1,nl)
85 idir = icfield(2,nl)
86 ifunc= icfield(3,nl)
87 iad = icfield(4,nl)
88 iadf = iad+itask*nn/nthread
89 iadl = iad-1+(itask+1)*nn/nthread
90 ifra = icfield(7,nl)
91 n1fram = 0
92 IF(ifra /= 0) n1fram = iframe(1,ifra+1)
93 imovfram = 0
94 IF (n1fram /= 0) THEN
95 vn1fram(1) = v(1,n1fram)
96 vn1fram(2) = v(2,n1fram)
97 vn1fram(3) = v(3,n1fram)
98 an1fram(1) = a(1,n1fram)
99 an1fram(2) = a(2,n1fram)
100 an1fram(3) = a(3,n1fram)
101 imovfram = 1
102 ELSE
103 vn1fram(1) = zero
104 vn1fram(2) = zero
105 vn1fram(3) = zero
106 an1fram(1) = zero
107 an1fram(2) = zero
108 an1fram(3) = zero
109 ENDIF
110 iflag=icfield(8,nl)
111 isens = icfield(6,nl)
112 IF(isens==0)THEN
113 ts=tt
114 ELSE
115 ts = tt-sensor_tab(isens)%TSTART
116 IF(ts<zero)cycle
117 ENDIF
118
119 is_tabulated = npc(2*nfunct+ifunc+1)
120 IF(is_tabulated >= 0) THEN
121 vrot = fac(1,nl)*finter(ifunc,ts*fac(2,nl),npc,tf,dydx)
122 ELSE
123 is_tabulated = -is_tabulated
124 CALL python_call_funct1d(python, is_tabulated,ts*fac(2,nl), vrot)
125 vrot = vrot * fac(1,nl)
126 ENDIF
127
128 vrot2 = vrot*vrot
129 x0 = xframe(10,ifra+1)
130 y0 = xframe(11,ifra+1)
131 z0 = xframe(12,ifra+1)
132 IF(idir == 4) THEN
133 x2 = xframe(1,ifra+1)
134 y2 = xframe(2,ifra+1)
135 z2 = xframe(3,ifra+1)
136 ELSEIF(idir == 5) THEN
137 x2 = xframe(4,ifra+1)
138 y2 = xframe(5,ifra+1)
139 z2 = xframe(6,ifra+1)
140 ELSE !IF(IDIR == 6) THEN
141 x2 = xframe(7,ifra+1)
142 y2 = xframe(8,ifra+1)
143 z2 = xframe(9,ifra+1)
144 ENDIF
145
146 IF (iflag == 2 .AND. imovfram == 1) THEN
147 dwdt = fac(1,nl)*dydx
148#include "vectorize.inc"
149 DO j=iadf,iadl
150 n1=iabs(ib(j))
151 x1 = x(1,n1)-x0
152 y1 = x(2,n1)-y0
153 z1 = x(3,n1)-z0
154 dist(1)=x1-(x1*x2+y1*y2+z1*z2)*x2
155 dist(2)=y1-(x1*x2+y1*y2+z1*z2)*y2
156 dist(3)=z1-(x1*x2+y1*y2+z1*z2)*z2
157 dw(1) = dwdt*x2
158 dw(2) = dwdt*y2
159 dw(3) = dwdt*z2
160 arel(1) = dist(1)*vrot2 + dw(2) * dist(3) - dw(3) * dist(2)
161 arel(2) = dist(2)*vrot2 + dw(3) * dist(1) - dw(1) * dist(3)
162 arel(3) = dist(3)*vrot2 + dw(1) * dist(2) - dw(2) * dist(1)
163 CALL relfram_m1(x(1,n1) ,v(1,n1), arel , xframe(1,ifra+1), vn1fram , an1fram )
164 a(1,n1)=a(1,n1)+arel(1)
165 a(2,n1)=a(2,n1)+arel(2)
166 a(3,n1)=a(3,n1)+arel(3)
167 IF(ib(j)>0)THEN
168 vmx=v(1,n1)+half*dt2*a(1,n1) ! Supposing A will be no more modified...
169 vmy=v(2,n1)+half*dt2*a(2,n1)
170 vmz=v(3,n1)+half*dt2*a(3,n1)
171 wfextt=wfextt + ms(n1)*(arel(1)*vmx+arel(2)*vmy+arel(3)*vmz)*dt12*weight(n1)
172 END IF
173 ENDDO
174 ELSEIF(iflag == 2) THEN
175 dwdt = fac(1,nl)*dydx
176#include "vectorize.inc"
177 DO j=iadf,iadl
178 n1=iabs(ib(j))
179 x1 = x(1,n1)-x0
180 y1 = x(2,n1)-y0
181 z1 = x(3,n1)-z0
182 dist(1)=x1-(x1*x2+y1*y2+z1*z2)*x2
183 dist(2)=y1-(x1*x2+y1*y2+z1*z2)*y2
184 dist(3)=z1-(x1*x2+y1*y2+z1*z2)*z2
185 dw(1) = dwdt*x2
186 dw(2) = dwdt*y2
187 dw(3) = dwdt*z2
188 arel(1) = dist(1)*vrot2 + dw(2) * dist(3) - dw(3) * dist(2)
189 arel(2) = dist(2)*vrot2 + dw(3) * dist(1) - dw(1) * dist(3)
190 arel(3) = dist(3)*vrot2 + dw(1) * dist(2) - dw(2) * dist(1)
191 a(1,n1)=a(1,n1)+arel(1)
192 a(2,n1)=a(2,n1)+arel(2)
193 a(3,n1)=a(3,n1)+arel(3)
194 IF(ib(j)>0)THEN
195 vmx=v(1,n1)+half*dt2*a(1,n1) ! Supposing A will be no more modified...
196 vmy=v(2,n1)+half*dt2*a(2,n1)
197 vmz=v(3,n1)+half*dt2*a(3,n1)
198 wfextt=wfextt+ms(n1)*(arel(1)*vmx+arel(2)*vmy+arel(3)*vmz)*dt12*weight(n1)
199 END IF
200 ENDDO
201 ELSEIF(imovfram == 1) THEN
202#include "vectorize.inc"
203 DO j=iadf,iadl
204 n1=iabs(ib(j))
205 x1 = x(1,n1)-x0
206 y1 = x(2,n1)-y0
207 z1 = x(3,n1)-z0
208 dist(1)=x1-(x1*x2+y1*y2+z1*z2)*x2
209 dist(2)=y1-(x1*x2+y1*y2+z1*z2)*y2
210 dist(3)=z1-(x1*x2+y1*y2+z1*z2)*z2
211 arel(1) = dist(1)*vrot2
212 arel(2) = dist(2)*vrot2
213 arel(3) = dist(3)*vrot2
214 CALL relfram_m1(x(1,n1) ,v(1,n1), arel , xframe(1,ifra+1),vn1fram , an1fram )
215 a(1,n1)=a(1,n1)+arel(1)
216 a(2,n1)=a(2,n1)+arel(2)
217 a(3,n1)=a(3,n1)+arel(3)
218 IF(ib(j)>0)THEN
219 vmx=v(1,n1)+half*dt2*a(1,n1) ! Supposing A will be no more modified...
220 vmy=v(2,n1)+half*dt2*a(2,n1)
221 vmz=v(3,n1)+half*dt2*a(3,n1)
222 wfextt=wfextt+ms(n1)*(arel(1)*vmx+arel(2)*vmy+arel(3)*vmz)*dt12*weight(n1)
223 END IF
224 ENDDO
225 ELSE
226#include "vectorize.inc"
227 DO j=iadf,iadl
228 n1=iabs(ib(j))
229 x1 = x(1,n1)-x0
230 y1 = x(2,n1)-y0
231 z1 = x(3,n1)-z0
232 dist(1)=x1-(x1*x2+y1*y2+z1*z2)*x2
233 dist(2)=y1-(x1*x2+y1*y2+z1*z2)*y2
234 dist(3)=z1-(x1*x2+y1*y2+z1*z2)*z2
235 arel(1) = dist(1)*vrot2
236 arel(2) = dist(2)*vrot2
237 arel(3) = dist(3)*vrot2
238 a(1,n1)=a(1,n1)+arel(1)
239 a(2,n1)=a(2,n1)+arel(2)
240 a(3,n1)=a(3,n1)+arel(3)
241 IF(ib(j)>0)THEN
242 vmx=v(1,n1)+half*dt2*a(1,n1) ! Supposing A will be no more modified...
243 vmy=v(2,n1)+half*dt2*a(2,n1)
244 vmz=v(3,n1)+half*dt2*a(3,n1)
245 wfextt=wfextt +ms(n1)*(arel(1)*vmx+arel(2)*vmy+arel(3)*vmz)*dt12*weight(n1)
246 END IF
247 ENDDO
248 ENDIF
249C /---------------/
250 CALL my_barrier
251C /---------------/
252 ENDDO
253C
254!$OMP ATOMIC
255 wfext = wfext + wfextt
256C
257 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
relfram_m1
subroutine relfram_m1(xg, vg, arel, xframe, vo, ao)
Definition relfram_m1.F:31
nl
character *2 function nl()
Definition message.F:2354
my_barrier
subroutine my_barrier
Definition machine.F:31