OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sensor_rbody.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_rbody ../engine/source/tools/sensor/sensor_rbody.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_rbody(SENSOR ,DIMFB ,STABS ,TABS ,FBSAV6)
32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE sensor_mod
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "com04_c.inc"
44#include "com08_c.inc"
45#include "units_c.inc"
46#include "comlock.inc"
47#include "task_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER :: DIMFB,STABS
52 INTEGER :: TABS(STABS)
53 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
54 TYPE (SENSOR_STR_) ,TARGET :: SENSOR
55C----------------------------------------------------------
56C Local Variables
57C----------------------------------------------------------
58 INTEGER I,RBOD_ID,IDIR,ICRIT,ISECT,IFLAG,IAD
59c
60 my_real :: fmin,fmax,fx,fy,fz,ff,tstart,tmin,tdelay,infinity
61 parameter(infinity = 1.0e20)
62C=======================================================================
63 IF (sensor%STATUS == 1) RETURN ! already activated
64c
65 tstart = sensor%TSTART
66 tmin = sensor%TMIN
67 tdelay = sensor%TDELAY
68c
69 rbod_id = sensor%IPARAM(1)
70 idir = sensor%IPARAM(2)
71 fmin = sensor%RPARAM(1)
72 fmax = sensor%RPARAM(2)
73 icrit = 0
74 iflag = 0
75c
76 iad = ninter + nrwall + rbod_id
77 isect = tabs(rbod_id + nsect + ninter + nintsub+nrwall+1)
78 . - tabs(rbod_id + nsect + ninter + nintsub+nrwall)
79 IF (idir == 1) THEN
80 fx = fbsav6(1,1,isect) + fbsav6(1,2,isect)
81 . + fbsav6(1,3,isect) + fbsav6(1,4,isect)
82 . + fbsav6(1,5,isect) + fbsav6(1,6,isect)
83 fy = fbsav6(2,1,isect) + fbsav6(2,2,isect)
84 . + fbsav6(2,3,isect) + fbsav6(2,4,isect)
85 . + fbsav6(2,5,isect) + fbsav6(2,6,isect)
86 fz = fbsav6(3,1,isect) + fbsav6(3,2,isect)
87 . + fbsav6(3,3,isect) + fbsav6(3,4,isect)
88 . + fbsav6(3,5,isect) + fbsav6(3,6,isect)
89 ff = sqrt(fx*fx + fy*fy + fz*fz)
90 ELSE !IF (IDIR == 2) THEN
91 fx = fbsav6(4,1,isect) + fbsav6(4,2,isect)
92 . + fbsav6(4,3,isect) + fbsav6(4,4,isect)
93 . + fbsav6(4,5,isect) + fbsav6(4,6,isect)
94 fy = fbsav6(5,1,isect) + fbsav6(5,2,isect)
95 . + fbsav6(5,3,isect) + fbsav6(5,4,isect)
96 . + fbsav6(5,5,isect) + fbsav6(5,6,isect)
97 fz = fbsav6(6,1,isect) + fbsav6(6,2,isect)
98 . + fbsav6(6,3,isect) + fbsav6(6,4,isect)
99 . + fbsav6(6,5,isect) + fbsav6(6,6,isect)
100 ff = sqrt(fx*fx + fy*fy + fz*fz)
101 ENDIF
102c
103 IF (ff < fmin) THEN
104 icrit = 1
105 iflag = 1
106 ELSE IF (ff > fmax) THEN
107 icrit = 1
108 iflag = 2
109 END IF
110 sensor%RESULTS(1) = ff
111c----------------------------------------------------------------
112c check activation status
113c----------------------------------------------------------------
114 IF (sensor%TCRIT + tmin > tt) THEN
115 IF (icrit == 0) THEN
116 sensor%TCRIT = infinity
117 ELSE IF (sensor%TCRIT == infinity) THEN
118 sensor%TCRIT = tt
119 END IF
120 END IF
121 IF (sensor%TCRIT < infinity) tstart = sensor%TCRIT + tmin + tdelay
122 IF (tstart <= tt) THEN ! sensor activation
123 sensor%STATUS = 1
124 sensor%TSTART = tstart
125 END IF
126c-----------------------------------------------------------------------
127 IF (sensor%STATUS == 1 .and. ispmd == 0) THEN
128#include "lockon.inc"
129 WRITE (istdo,1100) sensor%SENS_ID,sensor%TSTART
130 WRITE (iout ,1100) sensor%SENS_ID,sensor%TSTART
131 IF (iflag == 1) THEN
132 WRITE (iout ,1200) fmin,ff
133 ELSE IF (iflag == 2) THEN
134 WRITE (iout ,1300) fmax,ff
135 END IF
136#include "lockoff.inc"
137 ENDIF
138c-----------------------------------------------------------------------
1391100 FORMAT(' SENSOR (RBODY) NUMBER ',i10,' ,ACTIVATED AT TIME ',1pe12.5)
1401200 FORMAT(' TARGET MIN FORCE = ',1pe12.5,/
141 . ' CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5)
1421300 FORMAT(' TARGET MAX FORCE = ',1pe12.5,/
143 . ' CURRENT FORCE AFTER TMIN and TDELAY = ',1pe12.5)
144c-----------------------------------------------------------------------
145 RETURN
146 END SUBROUTINE
my_real
#define my_real
Definition cppsort.cpp:32
sensor_rbody
subroutine sensor_rbody(sensor, dimfb, stabs, tabs, fbsav6)
Definition sensor_rbody.F:32