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 SECT_ID,IDIR,ICRIT,ISECT,IAD,IFLAG
62c
63 my_real :: fmin,fmax,fx,fy,fz,ff,tstart,tmin,tdelay
64C=======================================================================
65 IF (sensor%STATUS == 1) RETURN ! already activated
66 ff = zero
67 fx = zero
68 fy = zero
69 fz = zero
70c
71 tstart = sensor%TSTART
72 tmin = sensor%TMIN
73 tdelay = sensor%TDELAY
74c
75 sect_id = sensor%IPARAM(1)
76 idir = sensor%IPARAM(2)
77 fmin = sensor%RPARAM(1)
78 fmax = sensor%RPARAM(2)
79 icrit = 0
80 iflag = 0
81c
82 iad = ninter + nrwall + nrbody + sect_id
83 isect = tabs(sect_id+1) - tabs(sect_id)
84c
85 IF (idir == 1) THEN ! normal force
86 IF (stabs == 0) THEN ! Parith/Off
87 fx = fsav(1,iad)
88 fy = fsav(2,iad)
89 fz = fsav(3,iad)
90 ELSE ! Parith/on
91 fx = fbsav6(1,1,isect)+fbsav6(1,2,isect)
92 . + fbsav6(1,3,isect)+fbsav6(1,4,isect)
93 . + fbsav6(1,5,isect)+fbsav6(1,6,isect)
94 fy = fbsav6(2,1,isect)+fbsav6(2,2,isect)
95 . + fbsav6(2,3,isect)+fbsav6(2,4,isect)
96 . + fbsav6(2,5,isect)+fbsav6(2,6,isect)
97 fz = fbsav6(3,1,isect)+fbsav6(3,2,isect)
98 . + fbsav6(3,3,isect)+fbsav6(3,4,isect)
99 . + fbsav6(3,5,isect)+fbsav6(3,6,isect)
100 ENDIF
101 ELSEIF (idir == 2) THEN ! tangent force
102 IF (stabs == 0) THEN ! Parith/Of
103 fx = fsav(4,iad)
104 fy = fsav(5,iad)
105 fz = fsav(6,iad)
106 ELSE ! Parith/on
107 fx = fbsav6(4,1,isect)+fbsav6(4,2,isect)
108 . + fbsav6(4,3,isect)+fbsav6(4,4,isect)
109 . + fbsav6(4,5,isect)+fbsav6(4,6,isect)
110 fy = fbsav6(5,1,isect)+fbsav6(5,2,isect)
111 . + fbsav6(5,3,isect)+fbsav6(5,4,isect)
112 . + fbsav6(5,5,isect)+fbsav6(5,6,isect)
113 fz = fbsav6(6,1,isect)+fbsav6(6,2,isect)
114 . + fbsav6(6,3,isect)+fbsav6(6,4,isect)
115 . + fbsav6(6,5,isect)+fbsav6(6,6,isect)
116 ENDIF
117 ELSEIF (idir == 3) THEN ! Total force
118 IF (stabs == 0) THEN ! Parith/Off
119 fx = fsav(34,iad)
120 fy = fsav(35,iad)
121 fz = fsav(36,iad)
122 ELSE ! Parith/on
123 fx = fbsav6(10,1,isect)+fbsav6(10,2,isect)
124 . + fbsav6(10,3,isect)+fbsav6(10,4,isect)
125 . + fbsav6(10,5,isect)+fbsav6(10,6,isect)
126 fy = fbsav6(11,1,isect)+fbsav6(11,2,isect)
127 . + fbsav6(11,3,isect)+fbsav6(11,4,isect)
128 . + fbsav6(11,5,isect)+fbsav6(11,6,isect)
129 fz = fbsav6(12,1,isect)+fbsav6(12,2,isect)
130 . + fbsav6(12,3,isect)+fbsav6(12,4,isect)
131 . + fbsav6(12,5,isect)+fbsav6(12,6,isect)
132 ENDIF
133 ELSEIF (idir == 4) THEN ! Total moment
134 IF (stabs == 0) THEN ! Parith/Off
135 fx = fsav(31,iad)
136 fy = fsav(32,iad)
137 fz = fsav(33,iad)
138 ELSE ! Parith/on
139 fx = fbsav6(7,1,isect)+fbsav6(7,2,isect)
140 . + fbsav6(7,3,isect)+fbsav6(7,4,isect)
141 . + fbsav6(7,5,isect)+fbsav6(7,6,isect)
142 fy = fbsav6(8,1,isect)+fbsav6(8,2,isect)
143 . + fbsav6(8,3,isect)+fbsav6(8,4,isect)
144 . + fbsav6(8,5,isect)+fbsav6(8,6,isect)
145 fz = fbsav6(9,1,isect)+fbsav6(9,2,isect)
146 . + fbsav6(9,3,isect)+fbsav6(9,4,isect)
147 . + fbsav6(9,5,isect)+fbsav6(9,6,isect)
148 ENDIF
149 ELSEIF (idir == 5) THEN ! FX
150 IF (stabs == 0) THEN ! Parith/Off
151 ff = fsav(1,iad) + fsav(4,iad)
152 ELSE ! Parith/on
153 ff = fbsav6(1,1,isect)+fbsav6(1,2,isect)
154 . + fbsav6(1,3,isect)+fbsav6(1,4,isect)
155 . + fbsav6(1,5,isect)+fbsav6(1,6,isect)
156 . + fbsav6(4,1,isect)+fbsav6(4,2,isect)
157 . + fbsav6(4,3,isect)+fbsav6(4,4,isect)
158 . + fbsav6(4,5,isect)+fbsav6(4,6,isect)
159 ENDIF
160 ELSEIF (idir == 6) THEN ! FY
161 IF (stabs == 0) then! Parith/Off
162 ff = fsav(2,iad) + fsav(5,iad)
163 ELSE ! Parith/on
164 ff = fbsav6(2,1,isect)+fbsav6(2,2,isect)
165 . + fbsav6(2,3,isect)+fbsav6(2,4,isect)
166 . + fbsav6(2,5,isect)+fbsav6(2,6,isect)
167 . + fbsav6(5,1,isect)+fbsav6(5,2,isect)
168 . + fbsav6(5,3,isect)+fbsav6(5,4,isect)
169 . + fbsav6(5,5,isect)+fbsav6(5,6,isect)
170 ENDIF
171 ELSEIF (idir == 7) THEN ! FZ
172 IF (stabs == 0) THEN ! Parith/Off
173 ff = fsav(3,iad) + fsav(6,iad)
174 ELSE ! Parith/on
175 ff = fbsav6(3,1,isect)+fbsav6(3,2,isect)
176 . + fbsav6(3,3,isect)+fbsav6(3,4,isect)
177 . + fbsav6(3,5,isect)+fbsav6(3,6,isect)
178 . + fbsav6(6,1,isect)+fbsav6(6,2,isect)
179 . + fbsav6(6,3,isect)+fbsav6(6,4,isect)
180 . + fbsav6(6,5,isect)+fbsav6(6,6,isect)
181 ENDIF
182 ELSEIF (idir == 8) THEN ! MX
183 IF (stabs == 0) then! Parith/Off
184 ff = fsav(31,iad)
185 ELSE ! Parith/on
186 ff = fbsav6(7,1,isect)+fbsav6(7,2,isect)
187 . + fbsav6(7,3,isect)+fbsav6(7,4,isect)
188 . + fbsav6(7,5,isect)+fbsav6(7,6,isect)
189 ENDIF
190 ELSEIF (idir == 9) THEN ! MY
191 IF (stabs == 0) then! Parith/Off
192 ff = fsav(32,iad)
193 ELSE ! Parith/on
194 ff = fbsav6(8,1,isect)+fbsav6(8,2,isect)
195 . + fbsav6(8,3,isect)+fbsav6(8,4,isect)
196 . + fbsav6(8,5,isect)+fbsav6(8,6,isect)
197 ENDIF
198 ELSEIF (idir == 10) THEN ! MZ
199 IF (stabs == 0) THEN ! Parith/Off
200 ff = fsav(33,iad)
201 ELSE ! Parith/on
202 ff = fbsav6(9,1,isect)+fbsav6(9,2,isect)
203 . + fbsav6(9,3,isect)+fbsav6(9,4,isect)
204 . + fbsav6(9,5,isect)+fbsav6(9,6,isect)
205 ENDIF
206 ENDIF
207c
208 IF (idir < 5) ff = sqrt(fx*fx + fy*fy + fz*fz)
209c
210 IF (ff < fmin) THEN
211 icrit = 1
212 iflag = 1
213 ELSE IF (ff > fmax) THEN
214 icrit = 1
215 iflag = 2
216 END IF
217c----------------------------------------------------------------
218c check activation status
219 IF (sensor%TCRIT + tmin > tt) THEN
220 IF (icrit == 0) THEN
221 sensor%TCRIT = infinity
222 ELSE IF (sensor%TCRIT == infinity) THEN
223 sensor%TCRIT = tt
224 END IF
225 END IF
226 IF (sensor%TCRIT < infinity) tstart = sensor%TCRIT + tmin + tdelay
227 IF (tstart <= tt) THEN ! sensor activation
228 sensor%STATUS = 1
229 sensor%TSTART = tstart
230 END IF
231c-----------------------------------------------------------------------
232 IF (sensor%STATUS == 1 .and. ispmd == 0) THEN
233#include "lockon.inc"
234 WRITE (istdo,1100) sensor%SENS_ID,sensor%TSTART
235 WRITE (iout ,1100) sensor%SENS_ID,sensor%TSTART
236 IF (iflag == 1) THEN
237 WRITE (iout ,1300) fmin,ff
238 ELSE IF (iflag == 2) THEN
239 WRITE (iout ,1400) fmax,ff
240 END IF
241#include "lockoff.inc"
242 ENDIF
243c-----------------------------------------------------------------------
2441100 FORMAT(' SENSOR (SECTION) NUMBER ',i10,' ,ACTIVATED AT TIME ',1pe12.5)
2451300 FORMAT(' TARGET MIN FORCE = ',1pe12.5,/
246 . ' CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5)
2471400 FORMAT(' TARGET MAX FORCE = ',1pe12.5,/
248 . ' CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5)
249c-----------------------------------------------------------------------
250 RETURN
my_real
#define my_real
Definition cppsort.cpp:32