OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sensor_energy.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "units_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "task_c.inc"
#include "parit_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sensor_energy (sensor, isens, subset, partsav2, nsensor, sensor_struct)

Function/Subroutine Documentation

◆ sensor_energy()

subroutine sensor_energy ( type (sensor_str_), intent(inout) sensor,
integer, intent(in) isens,
type (subset_), dimension(nsubs), intent(in) subset,
dimension(2,*), intent(in) partsav2,
integer, intent(in) nsensor,
type (sensor_type), dimension(nsensor), intent(inout) sensor_struct )

Definition at line 31 of file sensor_energy.F.

33c-----------------------------------------------------------------------
34!$comment
35! SENSOR_ENERGY description
36! SENSOR_ENERGY organization :
37! - computation
38! - sensor state modification
39!$ENDCOMMENT
40c-----------------------------------------------
41C M o d u l e s
42c-----------------------------------------------
43 USE groupdef_mod
44 USE sensor_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49#include "comlock.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "units_c.inc"
54#include "com04_c.inc"
55#include "com08_c.inc"
56#include "task_c.inc"
57#include "parit_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER ,INTENT(IN) :: NSENSOR
62 INTEGER ,INTENT(IN) :: ISENS
63 my_real ,INTENT(IN) :: partsav2(2,*)
64 TYPE (subset_) ,DIMENSION(NSUBS) ,INTENT(IN) :: subset
65 TYPE (SENSOR_STR_) ,INTENT(INOUT) :: SENSOR
66 TYPE (SENSOR_TYPE), DIMENSION(NSENSOR), INTENT(INOUT) :: SENSOR_STRUCT
67C----------------------------------------------------------
68C Local Variables
69C----------------------------------------------------------
70 INTEGER :: J,IPART,ISUBS,NBR_GROUP,NP,ITSK,IFLAG,ICONST,
71 . NI,NK,ICRIT,ICRIT1,ICRIT2,ISELECT
72 my_real :: tmin,tdelay,tstart,iemin,tcrit,
73 . eint,ekin,iemax,kemin,kemax,ietol,ietime,ketol,ketime,
74 . avg_ei,avg_ek,alphai,alphak
75c----------------------------------------------------------
76c SENSOR%VAR(1) = TCRIT1
77c SENSOR%VAR(2) = TSTART1
78c SENSOR%VAR(3) = TCRIT2
79c SENSOR%VAR(4) = TSTART2
80c SENSOR%VAR(5) = Mean EI
81c SENSOR%VAR(6) = Mean EK
82c SENSOR%VAR(7) = Alphai
83c SENSOR%VAR(8) = Alphak
84c SENSOR%VAR(9) = current total internal energy
85c SENSOR%VAR(10) = current total kinetic energy
86C=======================================================================
87 IF (sensor%STATUS == 1) RETURN ! already activated
88 avg_ek = zero
89 avg_ei = zero
90c
91 ipart = sensor%IPARAM(1)
92 isubs = sensor%IPARAM(2)
93 iconst = sensor%IPARAM(3)
94 iselect= sensor%IPARAM(4) ! Iselect == 2 => sensor will take total system energy
95c
96 tdelay = sensor%TDELAY
97 tmin = sensor%TMIN
98 tcrit = sensor%TCRIT
99 tstart = sensor%TSTART
100 iemin = sensor%RPARAM(1)
101 iemax = sensor%RPARAM(2)
102 kemin = sensor%RPARAM(3)
103 kemax = sensor%RPARAM(4)
104 ietol = sensor%RPARAM(5)
105 ketol = sensor%RPARAM(6)
106 ietime = sensor%RPARAM(7)
107 ketime = sensor%RPARAM(8)
108c
109 eint = zero
110 ekin = zero
111 icrit = 0
112 icrit1 = 0
113 icrit2 = 0
114 iflag = 0
115c---------------------------------------------------------
116c Fetch current energy values
117c---------------------------------------------------------
118
119 IF (iselect == 2) THEN ! total system energy
120 eint = sensor%VAR(9)
121 ekin = sensor%VAR(10)
122 ELSE ! PART / SUBSET energy
123 IF (iparit > 0) THEN
124 eint = zero
125 ekin = zero
126 nbr_group = sensor_struct(isens)%NUM_GROUP_PART
127 DO itsk=2,nthread
128 sensor_struct(isens)%FBSAV6_SENS(1,1:6,1) =
129 . sensor_struct(isens)%FBSAV6_SENS(1,1:6,1) +
130 . sensor_struct(isens)%FBSAV6_SENS(1,1:6,itsk)
131 sensor_struct(isens)%FBSAV6_SENS(2,1:6,1) =
132 . sensor_struct(isens)%FBSAV6_SENS(2,1:6,1) +
133 . sensor_struct(isens)%FBSAV6_SENS(2,1:6,itsk)
134 ENDDO
135
136 DO j=2,6
137 sensor_struct(isens)%FBSAV6_SENS(1,1,1) =
138 . sensor_struct(isens)%FBSAV6_SENS(1,1,1) + sensor_struct(isens)%FBSAV6_SENS(1,j,1)
139 sensor_struct(isens)%FBSAV6_SENS(2,1,1) =
140 . sensor_struct(isens)%FBSAV6_SENS(2,1,1) + sensor_struct(isens)%FBSAV6_SENS(2,j,1)
141 ENDDO
142 eint = sensor_struct(isens)%FBSAV6_SENS(1,1,1)
143 ekin = sensor_struct(isens)%FBSAV6_SENS(2,1,1)
144
145 DO itsk=1,nthread
146 DO j=1,6
147 sensor_struct(isens)%FBSAV6_SENS(1,j,itsk) = zero
148 sensor_struct(isens)%FBSAV6_SENS(2,j,itsk) = zero
149 ENDDO
150 ENDDO
151 ELSE ! PARTTH/OFF
152 eint = zero
153 ekin = zero
154 IF (ipart > 0) THEN
155 eint = partsav2(1,ipart)
156 ekin = partsav2(2,ipart)
157 ELSEIF (isubs > 0) THEN
158 np = subset(isubs)%NTPART
159 DO j=1,np
160 ipart= subset(isubs)%TPART(j)
161 eint = eint + partsav2(1,ipart)
162 ekin = ekin + partsav2(2,ipart)
163 ENDDO
164 ENDIF ! IF (IPART > 0)
165 ENDIF
166 ENDIF
167c---------------------------------------------------------
168c TEST of principal criterion (Emax, Emin)
169c---------------------------------------------------------
170 IF (eint < iemin) THEN
171 icrit = 1
172 iflag = 1
173 ELSE IF (eint > iemax) THEN
174 icrit = 1
175 iflag = 2
176 ELSE IF (ekin < kemin) THEN
177 icrit = 1
178 iflag = 3
179 ELSE IF (ekin > kemax) THEN
180 icrit = 1
181 iflag = 4
182 ENDIF
183 sensor%RESULTS(1) = eint
184 sensor%RESULTS(2) = ekin
185c
186 IF (sensor%TCRIT + tmin > tt) THEN
187 IF (icrit == 0) THEN
188 sensor%TCRIT = infinity
189 ELSE IF (sensor%TCRIT == infinity) THEN
190 sensor%TCRIT = min(sensor%TCRIT, tt)
191 END IF
192 ELSE IF (sensor%TSTART == infinity) THEN
193 sensor%TSTART = sensor%TCRIT + tmin + tdelay
194 END IF
195 IF (sensor%TSTART <= tt) THEN ! sensor activation
196 sensor%STATUS = 1
197 END IF
198c
199 IF (sensor%STATUS == 1 .and. ispmd == 0) THEN
200#include "lockon.inc"
201 WRITE (istdo,1000 ) sensor%SENS_ID,sensor%TSTART
202 WRITE (iout ,1000 ) sensor%SENS_ID,sensor%TSTART
203 IF (iflag == 1) THEN
204 WRITE (iout ,1100) iemin,eint
205 ELSE IF (iflag == 2) THEN
206 WRITE (iout ,1200) iemax,eint
207 ELSE IF (iflag == 3) THEN
208 WRITE (iout ,1300) kemin,ekin
209 ELSE IF (iflag == 4) THEN
210 WRITE (iout ,1400) kemax,ekin
211 END IF
212#include "lockoff.inc"
213 END IF
214c---------------------------------------------------------
215c TEST of constant internal energy criterion
216c---------------------------------------------------------
217 IF (iconst == 1) THEN
218 IF (tt == zero) THEN
219 ni = nint(ietime / dt2) + 1
220 nk = nint(ketime / dt2) + 1
221 sensor%VAR(1) = infinity ! TACT1
222 sensor%VAR(2) = infinity ! TSTART1
223 sensor%VAR(3) = infinity ! TACT2
224 sensor%VAR(4) = infinity ! TSTART2
225 sensor%VAR(7) = max(zero ,min(one ,two / ni))
226 sensor%VAR(8) = max(zero ,min(one ,two / nk))
227 END IF
228c
229 IF (eint > zero .and. ietol > zero) THEN
230 alphai = sensor%VAR(7)
231 avg_ei = alphai*eint + (one - alphai) * sensor%VAR(5)
232 sensor%VAR(5) = avg_ei
233 END IF
234c
235c Test sensor activation on constant internal energy criterion
236c
237 IF (eint > zero .and. eint < avg_ei + ietol .and. eint > avg_ei - ietol) icrit1 = 1
238c
239 IF (sensor%VAR(1) > tt) THEN
240 IF (icrit1 == 0) THEN
241 sensor%VAR(1) = infinity
242 ELSE IF (sensor%VAR(1) == infinity) THEN
243 sensor%VAR(1) = tt + ietime
244 END IF
245 ELSE IF (sensor%VAR(2) == infinity) THEN
246 sensor%VAR(2) = sensor%VAR(1) + tdelay
247 END IF
248 IF (sensor%VAR(2) <= tt) THEN ! sensor activation
249 sensor%STATUS = 1
250 sensor%TSTART = sensor%VAR(2)
251 END IF
252
253 IF (sensor%VAR(2) <= tt .and. ispmd == 0) THEN
254#include "lockon.inc"
255 WRITE (istdo,1000 ) sensor%SENS_ID,tt
256 WRITE (iout ,1000 ) sensor%SENS_ID,tt
257 WRITE (iout ,2100) eint,avg_ei
258#include "lockoff.inc"
259 END IF
260c
261c---------------------------------------------------------
262c Test sensor activation on constant kinetic energy criterion
263c---------------------------------------------------------
264 IF (ekin > zero .and. ketol > zero) THEN
265 alphak = sensor%VAR(8)
266 avg_ek = alphak*ekin + (one - alphak) * sensor%VAR(6)
267 sensor%VAR(6) = avg_ek
268 END IF
269
270 IF (ekin > zero .and. ekin < avg_ek + ketol .and. ekin > avg_ek - ketol) THEN
271 icrit2 = 1
272 END IF
273c
274 IF (sensor%VAR(3) > tt) THEN
275 IF (icrit2 == 0) THEN
276 sensor%VAR(3) = infinity
277 ELSE IF (sensor%VAR(3) == infinity) THEN
278 sensor%VAR(3) = tt + ketime
279 END IF
280 ELSE IF (sensor%VAR(4) == infinity) THEN
281 sensor%VAR(4) = sensor%VAR(3) + tdelay
282 END IF
283 IF (sensor%VAR(4) <= tt) THEN ! sensor activation
284 sensor%STATUS = 1
285 sensor%TSTART = sensor%VAR(4)
286 END IF
287c
288 IF (sensor%VAR(4) <= tt .and. ispmd == 0) THEN
289#include "lockon.inc"
290 WRITE (istdo,1000 ) sensor%SENS_ID,tt
291 WRITE (iout ,1000 ) sensor%SENS_ID,tt
292 WRITE (iout ,2200) ekin,avg_ek
293#include "lockoff.inc"
294 END IF
295c
296 END IF ! constant energy option
297c-----------------------------------------------------------------------
2981000 FORMAT(' ENERGY SENSOR NUMBER ',i10,' ACTIVATED AT TIME ',1pe12.5)
2991100 FORMAT(' TARGET MIN INTERNAL ENERGY = ',1pe12.5,/
300 . ' current internal energy after tmin and tdelay = ',1PE12.5)
3011200 FORMAT(' TARGET max internal energy = ',1PE12.5,/
302 . ' current internal energy after tmin and tdelay = ',1PE12.5)
3031300 FORMAT(' TARGET min kinetic energy = ',1PE12.5,/
304 . ' current kinetic energy after tmin and tdelay = ',1PE12.5)
3051400 FORMAT(' TARGET max kinetic energy = ',1PE12.5,/
306 . ' current kinetic energy after tmin and tdelay = ',1PE12.5)
3072100 FORMAT(' constant int energy = ',1PE12.5,', mean = ',1PE12.5)
3082200 FORMAT(' constant kin energy = ',1PE12.5,', mean = ',1PE12.5)
309c----------------------------------------------------------
310 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:668
groupdef_mod::subset_
Definition groupdef_mod.F:680