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,infinity
61 parameter(infinity = 1.0e20)
62C=======================================================================
63 tmin = sensor%TMIN
64 tdelay = sensor%TDELAY
65 tstart = sensor%TSTART
66 tstops = sensor%VALUE
67c
68 rw_id = sensor%IPARAM(1)
69 idir = sensor%IPARAM(2)
70 fmin = sensor%RPARAM(1)
71 fmax = sensor%RPARAM(2)
72 icrit = 0
73 acti = 0
74 ff = zero
75 fx = zero
76 fy = zero
77 fz = zero
78c
79 isect = tabs(nsect+rw_id+1)-tabs(nsect+rw_id)
80 n5 = rw_id + 4*nrwall
81c
82 IF (nprw(n5) == 1) THEN ! NPRW(N5) = ICONT - rigid wall contact flag
83 isect = tabs(rw_id+nsect+ninter+nintsub+1)-tabs(rw_id+nsect+ninter+nintsub)
84 IF (idir == 1) THEN
85 fx = 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)
88 ff = fx
89 ELSEIF (idir == 2) THEN
90 fy = fbsav6(2,1,isect)+fbsav6(2,2,isect)+
91 . fbsav6(2,3,isect)+fbsav6(2,4,isect)+
92 . fbsav6(2,5,isect)+fbsav6(2,6,isect)
93 ff = fy
94 ELSEIF (idir == 4) THEN
95 fz = fbsav6(3,1,isect)+fbsav6(3,2,isect)+
96 . fbsav6(3,3,isect)+fbsav6(3,4,isect)+
97 . fbsav6(3,5,isect)+fbsav6(3,6,isect)
98 ff = fz
99 ELSEIF (idir == 5) THEN
100 fx = fbsav6(1,1,isect)+fbsav6(1,2,isect)+
101 . fbsav6(1,3,isect)+fbsav6(1,4,isect)+
102 . fbsav6(1,5,isect)+fbsav6(1,6,isect)
103 fy = fbsav6(2,1,isect)+fbsav6(2,2,isect)+
104 . fbsav6(2,3,isect)+fbsav6(2,4,isect)+
105 . fbsav6(2,5,isect)+fbsav6(2,6,isect)
106 fz = fbsav6(3,1,isect)+fbsav6(3,2,isect)+
107 . fbsav6(3,3,isect)+fbsav6(3,4,isect)+
108 . fbsav6(3,5,isect)+fbsav6(3,6,isect)
109 ff = sqrt(fx*fx + fy*fy + fz*fz)
110 ELSEIF (idir == 6) THEN
111 fx = fbsav6(4,1,isect)+fbsav6(4,2,isect)+
112 . fbsav6(4,3,isect)+fbsav6(4,4,isect)+
113 . fbsav6(4,5,isect)+fbsav6(4,6,isect)
114 fy = fbsav6(5,1,isect)+fbsav6(5,2,isect)+
115 . fbsav6(5,3,isect)+fbsav6(5,4,isect)+
116 . fbsav6(5,5,isect)+fbsav6(5,6,isect)
117 fz = fbsav6(6,1,isect)+fbsav6(6,2,isect)+
118 . fbsav6(6,3,isect)+fbsav6(6,4,isect)+
119 . fbsav6(6,5,isect)+fbsav6(6,6,isect)
120 ff = sqrt(fx*fx + fy*fy + fz*fz)
121 ENDIF
122 sensor%RESULTS(1) = ff
123c
124 IF (ff < fmin .OR. ff > fmax .OR. idir == 0) icrit = 1
125c
126 ! check activation
127c
128 IF (icrit == 1) THEN
129 sensor%TCRIT = min(sensor%TCRIT, tt)
130 ELSE
131 sensor%TCRIT = infinity
132 END IF
133 IF (sensor%TCRIT + tmin <= tt) THEN
134 tstops = tt + tdelay
135 sensor%VALUE = tstops
136 IF (sensor%STATUS == 0) THEN
137 sensor%STATUS = 1
138 sensor%TSTART = tt
139 acti = 1
140 END IF
141 END IF
142c
143 ELSE ! ICONT = 0 => no contact
144 IF (tt > tstops .AND. sensor%STATUS == 1) THEN
145 sensor%STATUS = 0
146 sensor%TSTART = infinity
147 sensor%VALUE = infinity
148 acti = 2
149 END IF
150 END IF
151c
152c-----------------------------------------------------------------------
153 ! Output
154 IF (acti == 1) THEN
155 IF (ispmd == 0) THEN
156#include "lockon.inc"
157 WRITE (istdo,1100) sensor%SENS_ID,sensor%TSTART
158 IF (ff < fmin) THEN
159 WRITE (iout ,1200) sensor%SENS_ID,sensor%TSTART,fmin,ff
160 ELSE IF (ff > fmax) THEN
161 WRITE (iout ,1200) sensor%SENS_ID,sensor%TSTART,fmax,ff
162 END IF
163#include "lockoff.inc"
164 ENDIF
165 ELSE IF (acti == 2) THEN
166 IF (ispmd == 0) THEN
167#include "lockon.inc"
168 WRITE (istdo,1300) sensor%SENS_ID,sensor%TSTART
169 WRITE (iout ,1300) sensor%SENS_ID,sensor%TSTART
170#include "lockoff.inc"
171 END IF
172 END IF
173c-----------------------------------------------------------------------
1741100 FORMAT(' SENSOR (RWALL) NUMBER ',i10,' ,ACTIVATED AT TIME ' ,1pe12.5)
1751200 FORMAT(' SENSOR (RWALL) NUMBER ',i10,' ,ACTIVATED AT TIME ',1pe12.5/
176 . ' TARGET FORCE VALUE =',1pe12.5/
177 . ' CURRENT VALUE AT TMIN + TDELAY =',1pe12.5)
1781300 FORMAT(' SENSOR (RWALL) NUMBER ',i10,' ,DEACTIVATED AT TIME ',1pe12.5)
179c-----------------------------------------------------------------------
180 RETURN
181 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