OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rsens_nic.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/.
23!||====================================================================
24!|| rsens_nic ../engine/source/tools/sensor/rsens_nic.F
25!||--- called by ------------------------------------------------------
26!|| rforc3 ../engine/source/elements/spring/rforc3.F
27!||--- uses -----------------------------------------------------
28!|| element_mod ../common_source/modules/elements/element_mod.F90
29!|| sensor_mod ../common_source/modules/sensor_mod.F90
30!||====================================================================
31 SUBROUTINE rsens_nic(NEL ,IXR ,FOR ,MOM ,SKEW ,
32 . NSENSOR,SENSOR_TAB)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE sensor_mod
37 use element_mod , only : nixr
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "param_c.inc"
46#include "com04_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER ,INTENT(IN) :: NEL,NSENSOR
51 INTEGER ,DIMENSION(NIXR,NUMELR) ,INTENT(IN) :: IXR
52 my_real ,DIMENSION(NEL) ,INTENT(IN) :: for,mom
53 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(INOUT) :: SENSOR_TAB
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER :: I,J,SPRING_ID,ISENS,SPR_SKW,SEN_SKW,IDIR_F,IDIR_M
58 my_real :: fz,my,ftens,fcomp,mflex,mext,fgx,fgy,fgz,mgx,mgy,mgz
59 my_real ,DIMENSION(3) :: ff,mm
60 my_real ,DIMENSION(LSKEW,NUMSKW) :: skew
61c-----------------------------------------------------------------------
62c send current normalized forces and moments in the spring to sensor for processing
63c=======================================================================
64 isens = 0
65 DO j = 1,nsensor
66 IF (sensor_tab(j)%TYPE == 19) THEN ! sensor NIC_Nij
67 isens = j
68 sen_skw = sensor_tab(isens)%IPARAM(3)
69 spr_skw = sensor_tab(isens)%IPARAM(4)
70 idir_f = sensor_tab(isens)%IPARAM(5)
71 idir_m = sensor_tab(isens)%IPARAM(6)
72c
73 ftens = sensor_tab(isens)%RPARAM(2)
74 fcomp = sensor_tab(isens)%RPARAM(3)
75 mflex = sensor_tab(isens)%RPARAM(4)
76 mext = sensor_tab(isens)%RPARAM(5)
77 EXIT
78 END IF
79 END DO
80c we assume there's only one NIC-Nij sensor in the model
81 IF (isens > 0) THEN
82 my = zero
83 fz = zero
84 DO i = 1,nel
85 spring_id = ixr(6,i)
86 IF (sensor_tab(isens)%IPARAM(1) == spring_id) THEN
87 ff(1) = for(i)
88 ff(2) = for(i+nel)
89 ff(3) = for(i+nel*2)
90 mm(1) = mom(i)
91 mm(2) = mom(i+nel)
92 mm(3) = mom(i+nel*2)
93c rotate to sensor skew if necessary
94 IF (sen_skw > 1) THEN
95 IF (sen_skw /= spr_skw) THEN
96 fgx = skew(1,spr_skw)*ff(1)+skew(4,spr_skw)*ff(2)+skew(7,spr_skw)*ff(3)
97 fgy = skew(2,spr_skw)*ff(1)+skew(5,spr_skw)*ff(2)+skew(8,spr_skw)*ff(3)
98 fgz = skew(3,spr_skw)*ff(1)+skew(6,spr_skw)*ff(2)+skew(9,spr_skw)*ff(3)
99 ff(1) = skew(1,sen_skw)*fgx+skew(2,sen_skw)*fgy+skew(3,sen_skw)*fgz
100 ff(2) = skew(4,sen_skw)*fgx+skew(5,sen_skw)*fgy+skew(6,sen_skw)*fgz
101 ff(3) = skew(7,sen_skw)*fgx+skew(8,sen_skw)*fgy+skew(9,sen_skw)*fgz
102 mgx = skew(1,spr_skw)*mm(1)+skew(4,spr_skw)*mm(2)+skew(7,spr_skw)*mm(3)
103 mgy = skew(2,spr_skw)*mm(1)+skew(5,spr_skw)*mm(2)+skew(8,spr_skw)*mm(3)
104 mgz = skew(3,spr_skw)*mm(1)+skew(6,spr_skw)*mm(2)+skew(9,spr_skw)*mm(3)
105 mm(1) = skew(1,sen_skw)*mgx+skew(2,sen_skw)*mgy+skew(3,sen_skw)*mgz
106 mm(2) = skew(4,sen_skw)*mgx+skew(5,sen_skw)*mgy+skew(6,sen_skw)*mgz
107 mm(3) = skew(7,sen_skw)*mgx+skew(8,sen_skw)*mgy+skew(9,sen_skw)*mgz
108 END IF
109 fz = ff(idir_f)
110 my = mm(idir_m)
111 END IF
112c save normalized FZ and My values
113 IF (fz >= zero) THEN
114 fz = fz / ftens
115 ELSE
116 fz = abs(fz) / fcomp
117 END IF
118 IF (my >= zero) THEN
119 my = my / mflex
120 ELSE
121 my = abs(my) / mext
122 END IF
123 sensor_tab(isens)%VAR(1) = fz
124 sensor_tab(isens)%VAR(2) = my
125 sensor_tab(isens)%VAR(3) = one ! spmd flag for sensor indicating present domain
126 EXIT
127 END IF
128 END DO
129 END IF
130c-----------
131 RETURN
132 END
my_real
#define my_real
Definition cppsort.cpp:32
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
rsens_nic
subroutine rsens_nic(nel, ixr, for, mom, skew, nsensor, sensor_tab)
Definition rsens_nic.F:33