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 :: I,J,IPART,ISUBS,NBR_GROUP,NP,INDX,ITSK,IFLAG,ICONST,
71 . NI,NK,ICRIT,ICRIT1,ICRIT2,ISELECT
72 my_real :: tmin,tdelay,tstart,tstops,iemin,tcrit,
73 . eint,ekin,iemax,kemin,kemax,ietol,ietime,ketol,ketime,
74 . avg_ei,avg_ek,alphai,alphak,infinity
75 parameter(infinity = 1.0e20)
76c----------------------------------------------------------
77c SENSOR%VAR(1) = TCRIT1
78c SENSOR%VAR(2) = TSTART1
79c SENSOR%VAR(3) = TCRIT2
80c SENSOR%VAR(4) = TSTART2
81c SENSOR%VAR(5) = Mean EI
82c SENSOR%VAR(6) = Mean EK
83c SENSOR%VAR(7) = Alphai
84c SENSOR%VAR(8) = Alphak
85c SENSOR%VAR(9) = current total internal energy
86c SENSOR%VAR(10) = current total kinetic energy
87C=======================================================================
88 IF (sensor%STATUS == 1) RETURN ! already activated
89 avg_ek = zero
90 avg_ei = zero
91c
92 ipart = sensor%IPARAM(1)
93 isubs = sensor%IPARAM(2)
94 iconst = sensor%IPARAM(3)
95 iselect= sensor%IPARAM(4) ! Iselect == 2 => sensor will take total system energy
96c
97 tdelay = sensor%TDELAY
98 tmin = sensor%TMIN
99 tcrit = sensor%TCRIT
100 tstart = sensor%TSTART
101 iemin = sensor%RPARAM(1)
102 iemax = sensor%RPARAM(2)
103 kemin = sensor%RPARAM(3)
104 kemax = sensor%RPARAM(4)
105 ietol = sensor%RPARAM(5)
106 ketol = sensor%RPARAM(6)
107 ietime = sensor%RPARAM(7)
108 ketime = sensor%RPARAM(8)
109c
110 eint = zero
111 ekin = zero
112 icrit = 0
113 icrit1 = 0
114 icrit2 = 0
115 iflag = 0
116c---------------------------------------------------------
117c Fetch current energy values
118c---------------------------------------------------------
119
120 IF (iselect == 2) THEN ! total system energy
121 eint = sensor%VAR(9)
122 ekin = sensor%VAR(10)
123 ELSE ! PART / SUBSET energy
124 IF (iparit > 0) THEN
125 eint = zero
126 ekin = zero
127 nbr_group = sensor_struct(isens)%NUM_GROUP_PART
128 DO itsk=2,nthread
129 sensor_struct(isens)%FBSAV6_SENS(1,1:6,1) =
130 . sensor_struct(isens)%FBSAV6_SENS(1,1:6,1) +
131 . sensor_struct(isens)%FBSAV6_SENS(1,1:6,itsk)
132 sensor_struct(isens)%FBSAV6_SENS(2,1:6,1) =
133 . sensor_struct(isens)%FBSAV6_SENS(2,1:6,1) +
134 . sensor_struct(isens)%FBSAV6_SENS(2,1:6,itsk)
135 ENDDO
136
137 DO j=2,6
138 sensor_struct(isens)%FBSAV6_SENS(1,1,1) =
139 . sensor_struct(isens)%FBSAV6_SENS(1,1,1) + sensor_struct(isens)%FBSAV6_SENS(1,j,1)
140 sensor_struct(isens)%FBSAV6_SENS(2,1,1) =
141 . sensor_struct(isens)%FBSAV6_SENS(2,1,1) + sensor_struct(isens)%FBSAV6_SENS(2,j,1)
142 ENDDO
143 eint = sensor_struct(isens)%FBSAV6_SENS(1,1,1)
144 ekin = sensor_struct(isens)%FBSAV6_SENS(2,1,1)
145
146 DO itsk=1,nthread
147 DO j=1,6
148 sensor_struct(isens)%FBSAV6_SENS(1,j,itsk) = zero
149 sensor_struct(isens)%FBSAV6_SENS(2,j,itsk) = zero
150 ENDDO
151 ENDDO
152 ELSE ! PARTTH/OFF
153 eint = zero
154 ekin = zero
155 IF (ipart > 0) THEN
156 eint = partsav2(1,ipart)
157 ekin = partsav2(2,ipart)
158 ELSEIF (isubs > 0) THEN
159 np = subset(isubs)%NTPART
160 DO j=1,np
161 ipart= subset(isubs)%TPART(j)
162 eint = eint + partsav2(1,ipart)
163 ekin = ekin + partsav2(2,ipart)
164 ENDDO
165 ENDIF ! IF (IPART > 0)
166 ENDIF
167 ENDIF
168c---------------------------------------------------------
169c TEST of principal criterion (Emax, Emin)
170c---------------------------------------------------------
171 IF (eint < iemin) THEN
172 icrit = 1
173 iflag = 1
174 ELSE IF (eint > iemax) THEN
175 icrit = 1
176 iflag = 2
177 ELSE IF (ekin < kemin) THEN
178 icrit = 1
179 iflag = 3
180 ELSE IF (ekin > kemax) THEN
181 icrit = 1
182 iflag = 4
183 ENDIF
184 sensor%RESULTS(1) = eint
185 sensor%RESULTS(2) = ekin
186c
187 IF (sensor%TCRIT + tmin > tt) THEN
188 IF (icrit == 0) THEN
189 sensor%TCRIT = infinity
190 ELSE IF (sensor%TCRIT == infinity) THEN
191 sensor%TCRIT = min(sensor%TCRIT, tt)
192 END IF
193 ELSE IF (sensor%TSTART == infinity) THEN
194 sensor%TSTART = sensor%TCRIT + tmin + tdelay
195 END IF
196 IF (sensor%TSTART <= tt) THEN ! sensor activation
197 sensor%STATUS = 1
198 END IF
199c
200 IF (sensor%STATUS == 1 .and. ispmd == 0) THEN
201#include "lockon.inc"
202 WRITE (istdo,1000 ) sensor%SENS_ID,sensor%TSTART
203 WRITE (iout ,1000 ) sensor%SENS_ID,sensor%TSTART
204 IF (iflag == 1) THEN
205 WRITE (iout ,1100) iemin,eint
206 ELSE IF (iflag == 2) THEN
207 WRITE (iout ,1200) iemax,eint
208 ELSE IF (iflag == 3) THEN
209 WRITE (iout ,1300) kemin,ekin
210 ELSE IF (iflag == 4) THEN
211 WRITE (iout ,1400) kemax,ekin
212 END IF
213#include "lockoff.inc"
214 END IF
215c---------------------------------------------------------
216c TEST of constant internal energy criterion
217c---------------------------------------------------------
218 IF (iconst == 1) THEN
219 IF (tt == zero) THEN
220 ni = nint(ietime / dt2) + 1
221 nk = nint(ketime / dt2) + 1
222 sensor%VAR(1) = infinity ! TACT1
223 sensor%VAR(2) = infinity ! TSTART1
224 sensor%VAR(3) = infinity ! TACT2
225 sensor%VAR(4) = infinity ! TSTART2
226 sensor%VAR(7) = max(zero ,min(one ,two / ni))
227 sensor%VAR(8) = max(zero ,min(one ,two / nk))
228 END IF
229c
230 IF (eint > zero .and. ietol > zero) THEN
231 alphai = sensor%VAR(7)
232 avg_ei = alphai*eint + (one - alphai) * sensor%VAR(5)
233 sensor%VAR(5) = avg_ei
234 END IF
235c
236c Test sensor activation on constant internal energy criterion
237c
238 IF (eint > zero .and. eint < avg_ei + ietol .and. eint > avg_ei - ietol) icrit1 = 1
239c
240 IF (sensor%VAR(1) > tt) THEN
241 IF (icrit1 == 0) THEN
242 sensor%VAR(1) = infinity
243 ELSE IF (sensor%VAR(1) == infinity) THEN
244 sensor%VAR(1) = tt + ietime
245 END IF
246 ELSE IF (sensor%VAR(2) == infinity) THEN
247 sensor%VAR(2) = sensor%VAR(1) + tdelay
248 END IF
249 IF (sensor%VAR(2) <= tt) THEN ! sensor activation
250 sensor%STATUS = 1
251 sensor%TSTART = sensor%VAR(2)
252 END IF
253
254 IF (sensor%VAR(2) <= tt .and. ispmd == 0) THEN
255#include "lockon.inc"
256 WRITE (istdo,1000 ) sensor%SENS_ID,tt
257 WRITE (iout ,1000 ) sensor%SENS_ID,tt
258 WRITE (iout ,2100) eint,avg_ei
259#include "lockoff.inc"
260 END IF
261c
262c---------------------------------------------------------
263c Test sensor activation on constant kinetic energy criterion
264c---------------------------------------------------------
265 IF (ekin > zero .and. ketol > zero) THEN
266 alphak = sensor%VAR(8)
267 avg_ek = alphak*ekin + (one - alphak) * sensor%VAR(6)
268 sensor%VAR(6) = avg_ek
269 END IF
270
271 IF (ekin > zero .and. ekin < avg_ek + ketol .and. ekin > avg_ek - ketol) THEN
272 icrit2 = 1
273 END IF
274c
275 IF (sensor%VAR(3) > tt) THEN
276 IF (icrit2 == 0) THEN
277 sensor%VAR(3) = infinity
278 ELSE IF (sensor%VAR(3) == infinity) THEN
279 sensor%VAR(3) = tt + ketime
280 END IF
281 ELSE IF (sensor%VAR(4) == infinity) THEN
282 sensor%VAR(4) = sensor%VAR(3) + tdelay
283 END IF
284 IF (sensor%VAR(4) <= tt) THEN ! sensor activation
285 sensor%STATUS = 1
286 sensor%TSTART = sensor%VAR(4)
287 END IF
288c
289 IF (sensor%VAR(4) <= tt .and. ispmd == 0) THEN
290#include "lockon.inc"
291 WRITE (istdo,1000 ) sensor%SENS_ID,tt
292 WRITE (iout ,1000 ) sensor%SENS_ID,tt
293 WRITE (iout ,2200) ekin,avg_ek
294#include "lockoff.inc"
295 END IF
296c
297 END IF ! constant energy option
298c-----------------------------------------------------------------------
2991000 FORMAT(' ENERGY SENSOR NUMBER ',i10,' ACTIVATED AT TIME ',1pe12.5)
3001100 FORMAT(' TARGET MIN INTERNAL ENERGY = ',1pe12.5,/
301 . ' CURRENT INTERNAL ENERGY AFTER TMIN and TDELAY = ',1pe12.5)
3021200 FORMAT(' TARGET MAX INTERNAL ENERGY = ',1pe12.5,/
303 . ' CURRENT INTERNAL ENERGY AFTER TMIN and TDELAY = ',1pe12.5)
3041300 FORMAT(' TARGET MIN KINETIC ENERGY = ',1pe12.5,/
305 . ' CURRENT INTERNAL ENERGY AFTER TMIN and TDELAY = ',1pe12.5)
3061400 FORMAT(' TARGET MAX KINETIC ENERGY = ',1pe12.5,/
307 . ' CURRENT INTERNAL ENERGY AFTER TMIN and TDELAY = ',1pe12.5)
3082100 FORMAT(' CONSTANT INT ENERGY = ',1pe12.5,', MEAN = ',1pe12.5)
3092200 FORMAT(' CONSTANT KIN ENERGY = ',1pe12.5,', MEAN = ',1pe12.5)
310c----------------------------------------------------------
311 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:662
sensor_energy
subroutine sensor_energy(sensor, isens, subset, partsav2, nsensor, sensor_struct)
Definition sensor_energy.F:33