OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sensor_rwall.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_rwall ../engine/source/tools/sensor/sensor_rwall.F
26!||--- called by ------------------------------------------------------
27!|| sensor_base ../engine/source/tools/sensor/sensor_base.F
28!||--- uses -----------------------------------------------------
29!|| sensor_mod ../common_source/modules/sensor_mod.F90
30!||====================================================================
31 SUBROUTINE sensor_rwall(SENSOR ,
32 . NPRW ,DIMFB ,STABS ,TABS ,FBSAV6)
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 "com04_c.inc"
45#include "com08_c.inc"
46#include "units_c.inc"
47#include "comlock.inc"
48#include "task_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER :: DIMFB,STABS
53 INTEGER :: TABS(STABS),NPRW(*)
54 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
55 TYPE (SENSOR_STR_) ,TARGET :: SENSOR
56C----------------------------------------------------------
57C Local Variables
58C----------------------------------------------------------
59 INTEGER :: RW_ID,IDIR,ICRIT,ISECT,N5,ACTI
60 my_real :: fmin,fmax,ff,fx,fy,fz,tmin,tdelay,tstart,tstops
61C=======================================================================
62 tmin = sensor%TMIN
63 tdelay = sensor%TDELAY
64 tstart = sensor%TSTART
65 tstops = sensor%VALUE
66c
67 rw_id = sensor%IPARAM(1)
68 idir = sensor%IPARAM(2)
69 fmin = sensor%RPARAM(1)
70 fmax = sensor%RPARAM(2)
71 icrit = 0
72 acti = 0
73 ff = zero
74 fx = zero
75 fy = zero
76 fz = zero
77c
78 isect = tabs(nsect+rw_id+1)-tabs(nsect+rw_id)
79 n5 = rw_id + 4*nrwall
80c
81 IF (nprw(n5) == 1) THEN ! NPRW(N5) = ICONT - rigid wall contact flag
82 isect = tabs(rw_id+nsect+ninter+nintsub+1)-tabs(rw_id+nsect+ninter+nintsub)
83 IF (idir == 1) THEN
84 fx = 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)
87 ff = fx
88 ELSEIF (idir == 2) THEN
89 fy = fbsav6(2,1,isect)+fbsav6(2,2,isect)+
90 . fbsav6(2,3,isect)+fbsav6(2,4,isect)+
91 . fbsav6(2,5,isect)+fbsav6(2,6,isect)
92 ff = fy
93 ELSEIF (idir == 4) THEN
94 fz = fbsav6(3,1,isect)+fbsav6(3,2,isect)+
95 . fbsav6(3,3,isect)+fbsav6(3,4,isect)+
96 . fbsav6(3,5,isect)+fbsav6(3,6,isect)
97 ff = fz
98 ELSEIF (idir == 5) THEN
99 fx = fbsav6(1,1,isect)+fbsav6(1,2,isect)+
100 . fbsav6(1,3,isect)+fbsav6(1,4,isect)+
101 . fbsav6(1,5,isect)+fbsav6(1,6,isect)
102 fy = fbsav6(2,1,isect)+fbsav6(2,2,isect)+
103 . fbsav6(2,3,isect)+fbsav6(2,4,isect)+
104 . fbsav6(2,5,isect)+fbsav6(2,6,isect)
105 fz = fbsav6(3,1,isect)+fbsav6(3,2,isect)+
106 . fbsav6(3,3,isect)+fbsav6(3,4,isect)+
107 . fbsav6(3,5,isect)+fbsav6(3,6,isect)
108 ff = sqrt(fx*fx + fy*fy + fz*fz)
109 ELSEIF (idir == 6) THEN
110 fx = fbsav6(4,1,isect)+fbsav6(4,2,isect)+
111 . fbsav6(4,3,isect)+fbsav6(4,4,isect)+
112 . fbsav6(4,5,isect)+fbsav6(4,6,isect)
113 fy = fbsav6(5,1,isect)+fbsav6(5,2,isect)+
114 . fbsav6(5,3,isect)+fbsav6(5,4,isect)+
115 . fbsav6(5,5,isect)+fbsav6(5,6,isect)
116 fz = fbsav6(6,1,isect)+fbsav6(6,2,isect)+
117 . fbsav6(6,3,isect)+fbsav6(6,4,isect)+
118 . fbsav6(6,5,isect)+fbsav6(6,6,isect)
119 ff = sqrt(fx*fx + fy*fy + fz*fz)
120 ENDIF
121 sensor%RESULTS(1) = ff
122c
123 IF (ff < fmin .OR. ff > fmax .OR. idir == 0) icrit = 1
124c
125 ! check activation
126c
127 IF (icrit == 1) THEN
128 sensor%TCRIT = min(sensor%TCRIT, tt)
129 ELSE
130 sensor%TCRIT = infinity
131 END IF
132 IF (sensor%TCRIT + tmin <= tt) THEN
133 tstops = tt + tdelay
134 sensor%VALUE = tstops
135 IF (sensor%STATUS == 0) THEN
136 sensor%STATUS = 1
137 sensor%TSTART = tt
138 acti = 1
139 END IF
140 END IF
141c
142 ELSE ! ICONT = 0 => no contact
143 IF (tt > tstops .AND. sensor%STATUS == 1) THEN
144 sensor%STATUS = 0
145 sensor%TSTART = infinity
146 sensor%VALUE = infinity
147 acti = 2
148 END IF
149 END IF
150c
151c-----------------------------------------------------------------------
152 ! Output
153 IF (acti == 1) THEN
154 IF (ispmd == 0) THEN
155#include "lockon.inc"
156 WRITE (istdo,1100) sensor%SENS_ID,sensor%TSTART
157 IF (ff < fmin) THEN
158 WRITE (iout ,1200) sensor%SENS_ID,sensor%TSTART,fmin,ff
159 ELSE IF (ff > fmax) THEN
160 WRITE (iout ,1200) sensor%SENS_ID,sensor%TSTART,fmax,ff
161 END IF
162#include "lockoff.inc"
163 ENDIF
164 ELSE IF (acti == 2) THEN
165 IF (ispmd == 0) THEN
166#include "lockon.inc"
167 WRITE (istdo,1300) sensor%SENS_ID,sensor%TSTART
168 WRITE (iout ,1300) sensor%SENS_ID,sensor%TSTART
169#include "lockoff.inc"
170 END IF
171 END IF
172c-----------------------------------------------------------------------
1731100 FORMAT(' SENSOR (RWALL) NUMBER ',i10,' ,ACTIVATED AT TIME ' ,1pe12.5)
1741200 FORMAT(' SENSOR (RWALL) NUMBER ',i10,' ,ACTIVATED AT TIME ',1pe12.5/
175 . ' TARGET FORCE VALUE =',1pe12.5/
176 . ' CURRENT VALUE AT TMIN + TDELAY =',1pe12.5)
1771300 FORMAT(' SENSOR (RWALL) NUMBER ',i10,' ,DEACTIVATED AT TIME ',1pe12.5)
178c-----------------------------------------------------------------------
179 RETURN
180 END SUBROUTINE
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
sensor_rwall
subroutine sensor_rwall(sensor, nprw, dimfb, stabs, tabs, fbsav6)
Definition sensor_rwall.F:33