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,infinity
65 parameter(infinity = 1.0e20)
66C=======================================================================
67 tmin = sensor%TMIN
68 tdelay = sensor%TDELAY
69 tcrit = sensor%TCRIT
70 tstops = sensor%VALUE
71c
72 int_id = sensor%IPARAM(1)
73 intsub = sensor%IPARAM(2)
74 idir = sensor%IPARAM(3)
75 fmin = sensor%RPARAM(1)
76 fmax = sensor%RPARAM(2)
77 freq = sensor%RPARAM(3)
78c
79 isect = tabs(nsect+int_id+1)-tabs(nsect+int_id)
80 icrit = 0
81 iflag = 0
82 ff = zero
83c
84 IF (idir == 1) THEN
85 ff = sqrt((fbsav6(1,1,isect) + fbsav6(1,2,isect)
86 . + fbsav6(1,3,isect) + fbsav6(1,4,isect)
87 . + fbsav6(1,5,isect) + fbsav6(1,6,isect))**2
88 . + (fbsav6(2,1,isect) + fbsav6(2,2,isect)
89 . + fbsav6(2,3,isect) + fbsav6(2,4,isect)
90 . + fbsav6(2,5,isect) + fbsav6(2,6,isect))**2
91 . + (fbsav6(3,1,isect) + fbsav6(3,2,isect)
92 . + fbsav6(3,3,isect) + fbsav6(3,4,isect)
93 . + fbsav6(3,5,isect) + fbsav6(3,6,isect))**2)
94 ELSEIF (idir == 2) THEN
95 ff = sqrt((fbsav6(4,1,isect)+fbsav6(4,2,isect)
96 . + fbsav6(4,3,isect)+fbsav6(4,4,isect)
97 . + fbsav6(4,5,isect)+fbsav6(4,6,isect))**2
98 . + (fbsav6(5,1,isect)+fbsav6(5,2,isect)
99 . + fbsav6(5,3,isect)+fbsav6(5,4,isect)
100 . + fbsav6(5,5,isect)+fbsav6(5,6,isect))**2
101 . + (fbsav6(6,1,isect)+fbsav6(6,2,isect)
102 . + fbsav6(6,3,isect)+fbsav6(6,4,isect)
103 . + fbsav6(6,5,isect)+fbsav6(6,6,isect))**2)
104 END IF
105c
106 IF (freq > zero) THEN ! Filter contact forces (Butterworth)
107 IF (tt == zero) THEN
108 vv1 = ff
109 vv2 = ff
110 fv1 = ff
111 fv2 = ff
112 sensor%VAR(1) = vv1
113 sensor%VAR(2) = vv2
114 sensor%VAR(3) = fv1
115 sensor%VAR(4) = fv2
116 ENDIF
117c
118 vv1 = sensor%VAR(1)
119 vv2 = sensor%VAR(2)
120 fv1 = sensor%VAR(3)
121 fv2 = sensor%VAR(4)
122 CALL butterworth(dt2,freq,vv2,vv1,ff,fv2,fv1,fv)
123 sensor%VAR(1) = ff
124 sensor%VAR(2) = vv1
125 sensor%VAR(3) = fv
126 sensor%VAR(4) = fv1
127 ff = fv
128 END IF
129c
130 IF (ff < fmin) THEN
131 icrit = 1
132 iflag = 1
133 ELSE IF (ff > fmax) THEN
134 icrit = 1
135 iflag = 2
136 END IF
137 sensor%RESULTS(1) = ff
138c----------------------------------------------------------------
139c check activation status
140c----------------------------------------------------------------
141 id_inter = int_id
142 IF (int_id > ninter) id_inter = intsub
143c
144 IF (ipari(29,id_inter) == 1) THEN
145c
146 IF (icrit == 1) THEN
147 tcrit = min(tcrit, tt)
148 ELSE
149 tcrit = infinity
150 ENDIF
151 sensor%TCRIT = tcrit
152
153 IF (tcrit + tmin <= tt) THEN ! activation
154 tstops = tt + tdelay
155 sensor%VALUE = tstops
156
157 IF (sensor%STATUS == 0) THEN
158 sensor%STATUS = 1
159 tstart = tt
160 sensor%TSTART = tstart
161 IF (ispmd == 0) THEN
162#include "lockon.inc"
163 WRITE (istdo,1100) sensor%SENS_ID,sensor%TSTART
164 WRITE (iout ,1100) sensor%SENS_ID,sensor%TSTART
165 IF (iflag == 1) THEN
166 WRITE (iout ,1300) fmin,ff
167 ELSE IF (iflag == 2) THEN
168 WRITE (iout ,1400) fmax,ff
169 END IF
170#include "lockoff.inc"
171 ENDIF
172 ENDIF
173 ENDIF
174c
175 ELSE IF (tt > tstops .AND. sensor%STATUS == 1) THEN ! deactivation
176c
177 sensor%STATUS = 0
178 sensor%TSTART = infinity
179 sensor%TCRIT = infinity
180 sensor%VALUE = infinity
181
182 IF (ispmd == 0) THEN
183#include "lockon.inc"
184 WRITE (istdo,1200) sensor%SENS_ID,tt
185 WRITE (iout ,1200) sensor%SENS_ID,tt
186#include "lockoff.inc"
187 END IF
188 ENDIF
189c-----------------------------------------------------------------------
1901100 FORMAT(' SENSOR (INTER) NUMBER ',i10,' ACTIVATED AT TIME ' ,1pe12.5)
1911200 FORMAT(' SENSOR (INTER) NUMBER ',i10,' DEACTIVATED AT TIME ',1pe12.5)
1921300 FORMAT(' TARGET MIN FORCE = ',1pe12.5,/
193 . ' CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5/)
1941400 FORMAT(' TARGET MAX FORCE = ',1pe12.5,/
195 . ' CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5/)
196c-----------------------------------------------------------------------
197 RETURN
198 END SUBROUTINE sensor_contact
199
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_contact
subroutine sensor_contact(sensor, ipari, dimfb, stabs, tabs, fbsav6)
Definition sensor_contact.F:35