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

Go to the source code of this file.

Functions/Subroutines

subroutine sensor_section (sensor, dimfb, stabs, tabs, fsav, fbsav6)

Function/Subroutine Documentation

◆ sensor_section()

subroutine sensor_section ( type (sensor_str_), target sensor,
integer dimfb,
integer stabs,
integer, dimension(stabs) tabs,
dimension(nthvki,*) fsav,
double precision, dimension(12,6,dimfb) fbsav6 )

Definition at line 31 of file sensor_section.F.

33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE sensor_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "param_c.inc"
45#include "com04_c.inc"
46#include "com08_c.inc"
47#include "units_c.inc"
48#include "comlock.inc"
49#include "task_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER :: DIMFB,STABS
54 INTEGER :: TABS(STABS)
55 DOUBLE PRECISION ,DIMENSION(12,6,DIMFB) :: FBSAV6
56 my_real ,DIMENSION(NTHVKI,*) :: fsav
57 TYPE (sensor_str_) ,TARGET :: sensor
58C----------------------------------------------------------
59C Local Variables
60C----------------------------------------------------------
61 INTEGER I,SECT_ID,IDIR,ICRIT,ISECT,IAD,IFLAG
62c
63 my_real :: fmin,fmax,fx,fy,fz,ff,tstart,tmin,tdelay,infinity
64 parameter(infinity = 1.0e20)
65C=======================================================================
66 IF (sensor%STATUS == 1) RETURN ! already activated
67 ff = zero
68 fx = zero
69 fy = zero
70 fz = zero
71c
72 tstart = sensor%TSTART
73 tmin = sensor%TMIN
74 tdelay = sensor%TDELAY
75c
76 sect_id = sensor%IPARAM(1)
77 idir = sensor%IPARAM(2)
78 fmin = sensor%RPARAM(1)
79 fmax = sensor%RPARAM(2)
80 icrit = 0
81 iflag = 0
82c
83 iad = ninter + nrwall + nrbody + sect_id
84 isect = tabs(sect_id+1) - tabs(sect_id)
85c
86 IF (idir == 1) THEN ! normal force
87 IF (stabs == 0) THEN ! Parith/Off
88 fx = fsav(1,iad)
89 fy = fsav(2,iad)
90 fz = fsav(3,iad)
91 ELSE ! Parith/on
92 fx = fbsav6(1,1,isect)+fbsav6(1,2,isect)
93 . + fbsav6(1,3,isect)+fbsav6(1,4,isect)
94 . + fbsav6(1,5,isect)+fbsav6(1,6,isect)
95 fy = fbsav6(2,1,isect)+fbsav6(2,2,isect)
96 . + fbsav6(2,3,isect)+fbsav6(2,4,isect)
97 . + fbsav6(2,5,isect)+fbsav6(2,6,isect)
98 fz = fbsav6(3,1,isect)+fbsav6(3,2,isect)
99 . + fbsav6(3,3,isect)+fbsav6(3,4,isect)
100 . + fbsav6(3,5,isect)+fbsav6(3,6,isect)
101 ENDIF
102 ELSEIF (idir == 2) THEN ! tangent force
103 IF (stabs == 0) THEN ! Parith/Of
104 fx = fsav(4,iad)
105 fy = fsav(5,iad)
106 fz = fsav(6,iad)
107 ELSE ! Parith/on
108 fx = fbsav6(4,1,isect)+fbsav6(4,2,isect)
109 . + fbsav6(4,3,isect)+fbsav6(4,4,isect)
110 . + fbsav6(4,5,isect)+fbsav6(4,6,isect)
111 fy = fbsav6(5,1,isect)+fbsav6(5,2,isect)
112 . + fbsav6(5,3,isect)+fbsav6(5,4,isect)
113 . + fbsav6(5,5,isect)+fbsav6(5,6,isect)
114 fz = fbsav6(6,1,isect)+fbsav6(6,2,isect)
115 . + fbsav6(6,3,isect)+fbsav6(6,4,isect)
116 . + fbsav6(6,5,isect)+fbsav6(6,6,isect)
117 ENDIF
118 ELSEIF (idir == 3) THEN ! Total force
119 IF (stabs == 0) THEN ! Parith/Off
120 fx = fsav(34,iad)
121 fy = fsav(35,iad)
122 fz = fsav(36,iad)
123 ELSE ! Parith/on
124 fx = fbsav6(10,1,isect)+fbsav6(10,2,isect)
125 . + fbsav6(10,3,isect)+fbsav6(10,4,isect)
126 . + fbsav6(10,5,isect)+fbsav6(10,6,isect)
127 fy = fbsav6(11,1,isect)+fbsav6(11,2,isect)
128 . + fbsav6(11,3,isect)+fbsav6(11,4,isect)
129 . + fbsav6(11,5,isect)+fbsav6(11,6,isect)
130 fz = fbsav6(12,1,isect)+fbsav6(12,2,isect)
131 . + fbsav6(12,3,isect)+fbsav6(12,4,isect)
132 . + fbsav6(12,5,isect)+fbsav6(12,6,isect)
133 ENDIF
134 ELSEIF (idir == 4) THEN ! Total moment
135 IF (stabs == 0) THEN ! Parith/Off
136 fx = fsav(31,iad)
137 fy = fsav(32,iad)
138 fz = fsav(33,iad)
139 ELSE ! Parith/on
140 fx = fbsav6(7,1,isect)+fbsav6(7,2,isect)
141 . + fbsav6(7,3,isect)+fbsav6(7,4,isect)
142 . + fbsav6(7,5,isect)+fbsav6(7,6,isect)
143 fy = fbsav6(8,1,isect)+fbsav6(8,2,isect)
144 . + fbsav6(8,3,isect)+fbsav6(8,4,isect)
145 . + fbsav6(8,5,isect)+fbsav6(8,6,isect)
146 fz = fbsav6(9,1,isect)+fbsav6(9,2,isect)
147 . + fbsav6(9,3,isect)+fbsav6(9,4,isect)
148 . + fbsav6(9,5,isect)+fbsav6(9,6,isect)
149 ENDIF
150 ELSEIF (idir == 5) THEN ! FX
151 IF (stabs == 0) THEN ! Parith/Off
152 ff = fsav(1,iad) + fsav(4,iad)
153 ELSE ! Parith/on
154 ff = fbsav6(1,1,isect)+fbsav6(1,2,isect)
155 . + fbsav6(1,3,isect)+fbsav6(1,4,isect)
156 . + fbsav6(1,5,isect)+fbsav6(1,6,isect)
157 . + fbsav6(4,1,isect)+fbsav6(4,2,isect)
158 . + fbsav6(4,3,isect)+fbsav6(4,4,isect)
159 . + fbsav6(4,5,isect)+fbsav6(4,6,isect)
160 ENDIF
161 ELSEIF (idir == 6) THEN ! FY
162 IF (stabs == 0) then! Parith/Off
163 ff = fsav(2,iad) + fsav(5,iad)
164 ELSE ! parith/on
165 ff = fbsav6(2,1,isect)+fbsav6(2,2,isect)
166 . + fbsav6(2,3,isect)+fbsav6(2,4,isect)
167 . + fbsav6(2,5,isect)+fbsav6(2,6,isect)
168 . + fbsav6(5,1,isect)+fbsav6(5,2,isect)
169 . + fbsav6(5,3,isect)+fbsav6(5,4,isect)
170 . + fbsav6(5,5,isect)+fbsav6(5,6,isect)
171 ENDIF
172 ELSEIF (idir == 7) THEN ! FZ
173 IF (stabs == 0) THEN ! Parith/Off
174 ff = fsav(3,iad) + fsav(6,iad)
175 ELSE ! Parith/on
176 ff = fbsav6(3,1,isect)+fbsav6(3,2,isect)
177 . + fbsav6(3,3,isect)+fbsav6(3,4,isect)
178 . + fbsav6(3,5,isect)+fbsav6(3,6,isect)
179 . + fbsav6(6,1,isect)+fbsav6(6,2,isect)
180 . + fbsav6(6,3,isect)+fbsav6(6,4,isect)
181 . + fbsav6(6,5,isect)+fbsav6(6,6,isect)
182 ENDIF
183 ELSEIF (idir == 8) THEN ! MX
184 IF (stabs == 0) then! Parith/Off
185 ff = fsav(31,iad)
186 ELSE ! Parith/on
187 ff = fbsav6(7,1,isect)+fbsav6(7,2,isect)
188 . + fbsav6(7,3,isect)+fbsav6(7,4,isect)
189 . + fbsav6(7,5,isect)+fbsav6(7,6,isect)
190 ENDIF
191 ELSEIF (idir == 9) THEN ! MY
192 IF (stabs == 0) then! Parith/Off
193 ff = fsav(32,iad)
194 ELSE ! Parith/on
195 ff = fbsav6(8,1,isect)+fbsav6(8,2,isect)
196 . + fbsav6(8,3,isect)+fbsav6(8,4,isect)
197 . + fbsav6(8,5,isect)+fbsav6(8,6,isect)
198 ENDIF
199 ELSEIF (idir == 10) THEN ! MZ
200 IF (stabs == 0) THEN ! Parith/Off
201 ff = fsav(33,iad)
202 ELSE ! Parith/on
203 ff = fbsav6(9,1,isect)+fbsav6(9,2,isect)
204 . + fbsav6(9,3,isect)+fbsav6(9,4,isect)
205 . + fbsav6(9,5,isect)+fbsav6(9,6,isect)
206 ENDIF
207 ENDIF
208c
209 IF (idir < 5) ff = sqrt(fx*fx + fy*fy + fz*fz)
210c
211 IF (ff < fmin) THEN
212 icrit = 1
213 iflag = 1
214 ELSE IF (ff > fmax) THEN
215 icrit = 1
216 iflag = 2
217 END IF
218c----------------------------------------------------------------
219c check activation status
220 IF (sensor%TCRIT + tmin > tt) THEN
221 IF (icrit == 0) THEN
222 sensor%TCRIT = infinity
223 ELSE IF (sensor%TCRIT == infinity) THEN
224 sensor%TCRIT = tt
225 END IF
226 END IF
227 IF (sensor%TCRIT < infinity) tstart = sensor%TCRIT + tmin + tdelay
228 IF (tstart <= tt) THEN ! sensor activation
229 sensor%STATUS = 1
230 sensor%TSTART = tstart
231 END IF
232c-----------------------------------------------------------------------
233 IF (sensor%STATUS == 1 .and. ispmd == 0) THEN
234#include "lockon.inc"
235 WRITE (istdo,1100) sensor%SENS_ID,sensor%TSTART
236 WRITE (iout ,1100) sensor%SENS_ID,sensor%TSTART
237 IF (iflag == 1) THEN
238 WRITE (iout ,1300) fmin,ff
239 ELSE IF (iflag == 2) THEN
240 WRITE (iout ,1400) fmax,ff
241 END IF
242#include "lockoff.inc"
243 ENDIF
244c-----------------------------------------------------------------------
2451100 FORMAT(' SENSOR (SECTION) NUMBER ',i10,' ,ACTIVATED AT TIME ',1pe12.5)
2461300 FORMAT(' TARGET MIN FORCE = ',1pe12.5,/
247 . ' CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5)
2481400 FORMAT(' TARGET MAX FORCE = ',1pe12.5,/
249 . ' CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5)
250c-----------------------------------------------------------------------
251 RETURN
my_real
#define my_real
Definition cppsort.cpp:32