OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sensor_contact.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23C=======================================================================
24!||====================================================================
25!|| sensor_contact ../engine/source/tools/sensor/sensor_contact.F
26!||--- called by ------------------------------------------------------
27!|| sensor_base ../engine/source/tools/sensor/sensor_base.f
28!||--- calls -----------------------------------------------------
29!|| butterworth ../engine/source/tools/univ/butterworth.F
30!||--- uses -----------------------------------------------------
31!|| sensor_mod ../common_source/modules/sensor_mod.F90
32!||====================================================================
33 SUBROUTINE sensor_contact(SENSOR ,
34 . IPARI ,DIMFB ,STABS ,TABS ,FBSAV6)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE sensor_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "param_c.inc"
47#include "com04_c.inc"
48#include "com08_c.inc"
49#include "units_c.inc"
50#include "comlock.inc"
51#include "task_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER :: DIMFB,STABS
56 INTEGER :: TABS(STABS),IPARI(NPARI,NINTER)
57 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
58 TYPE (SENSOR_STR_) ,TARGET :: SENSOR
59C----------------------------------------------------------
60C Local Variables
61C----------------------------------------------------------
62 INTEGER :: INT_ID,INTSUB,ID_INTER,IDIR,ICRIT,ISECT,IFLAG
63 my_real :: fmin,fmax,ff,fv,fv1,fv2,vv1,vv2,freq,
64 . tmin,tdelay,tcrit,tstart,tstops
65C=======================================================================
66 tmin = sensor%TMIN
67 tdelay = sensor%TDELAY
68 tcrit = sensor%TCRIT
69 tstops = sensor%VALUE
70c
71 int_id = sensor%IPARAM(1)
72 intsub = sensor%IPARAM(2)
73 idir = sensor%IPARAM(3)
74 fmin = sensor%RPARAM(1)
75 fmax = sensor%RPARAM(2)
76 freq = sensor%RPARAM(3)
77c
78 isect = tabs(nsect+int_id+1)-tabs(nsect+int_id)
79 icrit = 0
80 iflag = 0
81 ff = zero
82c
83 IF (idir == 1) THEN
84 ff = sqrt((fbsav6(1,1,isect) + fbsav6(1,2,isect)
85 . + fbsav6(1,3,isect) + fbsav6(1,4,isect)
86 . + fbsav6(1,5,isect) + fbsav6(1,6,isect))**2
87 . + (fbsav6(2,1,isect) + fbsav6(2,2,isect)
88 . + fbsav6(2,3,isect) + fbsav6(2,4,isect)
89 . + fbsav6(2,5,isect) + fbsav6(2,6,isect))**2
90 . + (fbsav6(3,1,isect) + fbsav6(3,2,isect)
91 . + fbsav6(3,3,isect) + fbsav6(3,4,isect)
92 . + fbsav6(3,5,isect) + fbsav6(3,6,isect))**2)
93 ELSEIF (idir == 2) THEN
94 ff = sqrt((fbsav6(4,1,isect)+fbsav6(4,2,isect)
95 . + fbsav6(4,3,isect)+fbsav6(4,4,isect)
96 . + fbsav6(4,5,isect)+fbsav6(4,6,isect))**2
97 . + (fbsav6(5,1,isect)+fbsav6(5,2,isect)
98 . + fbsav6(5,3,isect)+fbsav6(5,4,isect)
99 . + fbsav6(5,5,isect)+fbsav6(5,6,isect))**2
100 . + (fbsav6(6,1,isect)+fbsav6(6,2,isect)
101 . + fbsav6(6,3,isect)+fbsav6(6,4,isect)
102 . + fbsav6(6,5,isect)+fbsav6(6,6,isect))**2)
103 END IF
104c
105 IF (freq > zero) THEN ! Filter contact forces (Butterworth)
106 IF (tt == zero) THEN
107 vv1 = ff
108 vv2 = ff
109 fv1 = ff
110 fv2 = ff
111 sensor%VAR(1) = vv1
112 sensor%VAR(2) = vv2
113 sensor%VAR(3) = fv1
114 sensor%VAR(4) = fv2
115 ENDIF
116c
117 vv1 = sensor%VAR(1)
118 vv2 = sensor%VAR(2)
119 fv1 = sensor%VAR(3)
120 fv2 = sensor%VAR(4)
121 CALL butterworth(dt2,freq,vv2,vv1,ff,fv2,fv1,fv)
122 sensor%VAR(1) = ff
123 sensor%VAR(2) = vv1
124 sensor%VAR(3) = fv
125 sensor%VAR(4) = fv1
126 ff = fv
127 END IF
128c
129 IF (ff < fmin) THEN
130 icrit = 1
131 iflag = 1
132 ELSE IF (ff > fmax) THEN
133 icrit = 1
134 iflag = 2
135 END IF
136 sensor%RESULTS(1) = ff
137c----------------------------------------------------------------
138c check activation status
139c----------------------------------------------------------------
140 id_inter = int_id
141 IF (int_id > ninter) id_inter = intsub
142c
143 IF (ipari(29,id_inter) == 1) THEN
144c
145 IF (icrit == 1) THEN
146 tcrit = min(tcrit, tt)
147 ELSE
148 tcrit = infinity
149 ENDIF
150 sensor%TCRIT = tcrit
151
152 IF (tcrit + tmin <= tt) THEN ! activation
153 tstops = tt + tdelay
154 sensor%VALUE = tstops
155
156 IF (sensor%STATUS == 0) THEN
157 sensor%STATUS = 1
158 tstart = tt
159 sensor%TSTART = tstart
160 IF (ispmd == 0) THEN
161#include "lockon.inc"
162 WRITE (istdo,1100) sensor%SENS_ID,sensor%TSTART
163 WRITE (iout ,1100) sensor%SENS_ID,sensor%TSTART
164 IF (iflag == 1) THEN
165 WRITE (iout ,1300) fmin,ff
166 ELSE IF (iflag == 2) THEN
167 WRITE (iout ,1400) fmax,ff
168 END IF
169#include "lockoff.inc"
170 ENDIF
171 ENDIF
172 ENDIF
173c
174 ELSE IF (tt > tstops .AND. sensor%STATUS == 1) THEN ! deactivation
175c
176 sensor%STATUS = 0
177 sensor%TSTART = infinity
178 sensor%TCRIT = infinity
179 sensor%VALUE = infinity
180
181 IF (ispmd == 0) THEN
182#include "lockon.inc"
183 WRITE (istdo,1200) sensor%SENS_ID,tt
184 WRITE (iout ,1200) sensor%SENS_ID,tt
185#include "lockoff.inc"
186 END IF
187 ENDIF
188c-----------------------------------------------------------------------
1891100 FORMAT(' SENSOR (INTER) NUMBER ',i10,' ACTIVATED AT TIME ' ,1pe12.5)
1901200 FORMAT(' SENSOR (INTER) NUMBER ',i10,' DEACTIVATED AT TIME ',1pe12.5)
1911300 FORMAT(' TARGET MIN FORCE = ',1pe12.5,/
192 . ' CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5/)
1931400 FORMAT(' TARGET MAX FORCE = ',1pe12.5,/
194 . ' CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5/)
195c-----------------------------------------------------------------------
196 RETURN
197 END SUBROUTINE sensor_contact
198
butterworth
subroutine butterworth(dt, freq, x2, x1, x, fx2, fx1, fx)
Definition butterworth.F:31
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
sensor_base
subroutine sensor_base(sensors, nsensor, time, timestep, xsens, ipari, partsav2, gauge, fsav, x, v, a, acc, nprw, subset, igrsurf, igrnod, python)
Definition sensor_base.F:57
sensor_contact
subroutine sensor_contact(sensor, ipari, dimfb, stabs, tabs, fbsav6)
Definition sensor_contact.F:35