OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inisen.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!|| inisen ../starter/source/tools/sensor/inisen.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| iniparsen ../starter/source/tools/sensor/iniparsen.F
30!|| sort_logical_sensors ../starter/source/tools/sensor/sort_logical_sensors.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../starter/share/message_module/message_mod.F
33!||====================================================================
34 SUBROUTINE inisen(SENSORS , IPARI ,NOM_OPT ,PTR_NOPT_RWALL,
35 . PTR_NOPT_SECT ,PTR_NOPT_INTER ,IXR ,R_SKEW ,NUMELR,
36 . NSECT ,NINTER ,NINTSUB ,NRWALL ,NRBODY )
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE message_mod
41 USE sensor_mod
42 USE names_and_titles_mod , ONLY : nchartitle
43 use element_mod , only : nixr
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "scr17_c.inc"
52#include "param_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER ,INTENT(IN) :: NUMELR,NSECT,NINTER,NINTSUB,NRWALL,NRBODY
57 INTEGER IPARI(NPARI,NINTER)
58 INTEGER NOM_OPT(LNOPT1,*),PTR_NOPT_RWALL,PTR_NOPT_SECT,PTR_NOPT_INTER
59 INTEGER ,DIMENSION(NUMELR) :: R_SKEW
60 INTEGER ,DIMENSION(NIXR,NUMELR) :: IXR
61 TYPE (SENSORS_) ,INTENT(INOUT) ,TARGET :: SENSORS
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I,J,K,IN,NSENSOR,IPARSENS,STABSEN,SFSAV,STAT,
66 . IS1,IS2,SENS_TYPE,SENS_ID,SPRING_ID
67 CHARACTER(LEN=NCHARTITLE)::TITR
68 TYPE (SENSOR_STR_) ,DIMENSION(:) ,POINTER :: SENSOR_TAB
69c=======================================================================
70C initialization of sensor parameters
71C---------------------------------------------
72 nsensor = sensors%NSENSOR
73 sensor_tab => sensors%SENSOR_TAB(1:nsensor)
74c
75 DO k=1,nsensor
76 is1 = 0
77 is2 = 0
78 in = 0
79 titr = 'SENSOR '
80 sens_id = sensor_tab(k)%SENS_ID
81 sens_type = sensor_tab(k)%TYPE
82c
83 IF (sens_type == 3) THEN
84C-------------------------------------
85C sensor of sensor
86C-------------------------------------
87 DO i=1,nsensor
88 IF (sensor_tab(k)%IPARAM(1) == sensor_tab(i)%SENS_ID) is1=i
89 IF (sensor_tab(k)%IPARAM(2) == sensor_tab(i)%SENS_ID) is2=i
90 ENDDO
91 IF (is1 == 0) THEN
92 CALL ancmsg(msgid=339,anmode=aninfo,msgtype=msgerror,
93 . i1=sens_id,
94 . c1=titr,
95 . i2=sensor_tab(k)%IPARAM(1),c2='SENSOR')
96 ENDIF
97 sensor_tab(k)%IPARAM(1) = is1
98 sensor_tab(k)%IPARAM(2) = is2
99c
100 ELSEIF (sens_type == 4 .OR. sens_type == 5) THEN
101C-------------------------------------
102C SENSOR of SENSOR 'AND' , 'OR'
103C-------------------------------------
104 DO i=1,nsensor
105 IF (sensor_tab(k)%IPARAM(1) == sensor_tab(i)%SENS_ID) is1=i
106 IF (sensor_tab(k)%IPARAM(2) == sensor_tab(i)%SENS_ID) is2=i
107 ENDDO
108 IF (is1 == 0) THEN
109 CALL ancmsg(msgid=339,anmode=aninfo,msgtype=msgerror,
110 . i1=sens_id,
111 . c1=titr,
112 . i2=sensor_tab(k)%IPARAM(1),c2='SENSOR')
113 ENDIF
114 IF (is2 == 0) THEN
115 CALL ancmsg(msgid=339,anmode=aninfo,msgtype=msgerror,
116 . i1=sens_id,
117 . c1=titr,
118 . i2=sensor_tab(k)%IPARAM(2),c2='SENSOR')
119 ENDIF
120 sensor_tab(k)%IPARAM(1) = is1
121 sensor_tab(k)%IPARAM(2) = is2
122c
123 ELSEIF (sens_type == 6) THEN
124C-------------------------------------
125C Contact sensor
126C-------------------------------------
127 DO i=1,ninter
128 IF (ipari(15,i) == sensor_tab(k)%IPARAM(1)) THEN
129 in=i
130 EXIT
131 ENDIF
132 ENDDO
133 DO i=1,nintsub
134 IF (nom_opt(1,ptr_nopt_inter+i) == sensor_tab(k)%IPARAM(1)) THEN
135 DO j=1,ninter
136 IF (ipari(15,j) == nom_opt(2,ptr_nopt_inter+i))THEN
137 in = i + ninter
138 sensor_tab(k)%IPARAM(2) = j
139 ENDIF
140 ENDDO
141 ENDIF
142 ENDDO
143 IF (in == 0)THEN
144
145 CALL ancmsg(msgid=339,anmode=aninfo,msgtype=msgerror,
146 . i1=sens_id,
147 . c1=titr,
148 . i2=sensor_tab(k)%IPARAM(1),c2='INTERFACE')
149 ENDIF
150 sensor_tab(k)%IPARAM(1) = in
151c
152 ELSEIF (sens_type == 7) THEN
153C-------------------------------------
154C RWALL
155C-------------------------------------
156 DO i=1,nrwall
157 IF (nom_opt(1,ptr_nopt_rwall+i) == sensor_tab(k)%IPARAM(1)) in=i
158 ENDDO
159 IF (in == 0)THEN
160 CALL ancmsg(msgid=339,anmode=aninfo,msgtype=msgerror,
161 . i1=sens_id,
162 . c1=titr,
163 . i2=sensor_tab(k)%IPARAM(1),c2='RIGID WALL')
164 ENDIF
165 sensor_tab(k)%IPARAM(1) = in
166c
167 ELSEIF (sens_type == 8)THEN
168C-------------------------------------
169C SENSOR of SENSOR
170C-------------------------------------
171 DO i=1,nsensor
172 IF (sensor_tab(k)%IPARAM(1) == sensor_tab(i)%SENS_ID) is1=i
173 ENDDO
174 IF(is1 == 0)THEN
175 CALL ancmsg(msgid=339,anmode=aninfo,msgtype=msgerror,
176 . i1=sens_id,
177 . c1=titr,
178 . i2=sensor_tab(k)%IPARAM(1),c2='SENSOR')
179 ENDIF
180 sensor_tab(k)%IPARAM(1) = is1
181c
182 ELSEIF (sens_type == 11)THEN
183C-------------------------------------
184C RBODY
185C-------------------------------------
186 DO i=1,nrbody
187 IF (nom_opt(1,i) == sensor_tab(k)%IPARAM(1)) in=i
188 ENDDO
189 IF (in == 0)THEN
190 CALL ancmsg(msgid=339,anmode=aninfo,msgtype=msgerror,
191 . i1=sens_id,
192 . c1=titr,
193 . i2=sensor_tab(k)%IPARAM(1),c2='RIGID BODY')
194 ENDIF
195 sensor_tab(k)%IPARAM(1) = in
196c
197 ELSEIF (sens_type == 12)THEN
198C-------------------------------------
199C SECTION
200C-------------------------------------
201 DO i=1,nsect
202 IF (nom_opt(1,ptr_nopt_sect +i) == sensor_tab(k)%IPARAM(1)) in=i
203 ENDDO
204 IF (in == 0)THEN
205 CALL ancmsg(msgid=339,anmode=aninfo,msgtype=msgerror,
206 . i1=sens_id,
207 . c1=titr,
208 . i2=sensor_tab(k)%IPARAM(1),c2='SECTION')
209 ENDIF
210 sensor_tab(k)%IPARAM(1) = in
211c---
212 ELSEIF (sens_type == 13) THEN
213C-------------------------------------
214C WORK
215C-------------------------------------
216c ID section
217 in = 0
218 DO i=1,nsect
219 IF (nom_opt(1,ptr_nopt_sect +i) == sensor_tab(k)%IPARAM(3)) in=i
220 ENDDO
221 sensor_tab(k)%IPARAM(3) = in
222c
223c ID INTERFACE
224 in = 0
225 DO i=1,ninter
226 IF (ipari(15,i) == sensor_tab(k)%IPARAM(4)) THEN
227 in=i
228 EXIT
229 ENDIF
230 ENDDO
231 DO i=1,nintsub
232 IF (nom_opt(1,ptr_nopt_inter+i) == sensor_tab(k)%IPARAM(5)) THEN
233 DO j=1,ninter
234 IF (ipari(15,j) == nom_opt(2,ptr_nopt_inter+i))THEN
235 in = i + ninter
236 sensor_tab(k)%IPARAM(5) = j
237 ENDIF
238 ENDDO
239 ENDIF
240 ENDDO
241 sensor_tab(k)%IPARAM(4) = in
242c
243c ID RWALL
244 in = 0
245 DO i=1,nrwall
246 IF (nom_opt(1,ptr_nopt_rwall+i) == sensor_tab(k)%IPARAM(6)) in=i
247 ENDDO
248 sensor_tab(k)%IPARAM(6) = in
249c
250c ID RBODY
251 in = 0
252 DO i=1,nrbody
253 IF (nom_opt(1,i) == sensor_tab(k)%IPARAM(7)) in=i
254 ENDDO
255 sensor_tab(k)%IPARAM(7) = in
256c
257 IF (sensor_tab(k)%IPARAM(3) == 0 .and. sensor_tab(k)%IPARAM(4) == 0 .and.
258 . sensor_tab(k)%IPARAM(5) == 0 .and. sensor_tab(k)%IPARAM(6) == 0 .and.
259 . sensor_tab(k)%IPARAM(7) == 0) THEN
260 CALL ancmsg(msgid=339,anmode=aninfo,msgtype=msgerror,
261 . i1=in,
262 . c1=titr,
263 . i2=sensor_tab(k)%SENS_ID,c2='ID in SENSOR WORK')
264 ENDIF
265c
266 ELSEIF (sens_type == 19) THEN
267C-------------------------------------
268C NIC_NIJ
269C-------------------------------------
270 spring_id = sensor_tab(k)%IPARAM(1)
271 DO i=1,numelr
272 IF (ixr(6,i) == spring_id) THEN
273 sensor_tab(k)%IPARAM(2) = i
274 sensor_tab(k)%IPARAM(4) = r_skew(i)
275 EXIT
276 END IF
277 ENDDO
278c---
279 ENDIF ! SENSOR TYPE
280 ENDDO
281c
282c----------------------------------------------------------------------
283c Logical sensors : AND, OR, NOT, SENS - create a dependency order
284c----------------------------------------------------------------------
285
286 CALL sort_logical_sensors(sensors)
287
288c----------------------------------------------------------------------
289c Allocate sensor arrays for PARITH_ON/SMPD exchange
290c----------------------------------------------------------------------
291 iparsens = 0 ! Flag pour sensor type force
292 sfsav = 0
293 stabsen = 0
294c
295 IF (nsensor > 0) THEN
296 DO i=1,nsensor
297 sens_type = sensor_tab(i)%TYPE
298 IF (sens_type== 6 .OR. sens_type== 7 .OR. sens_type== 11 .OR.
299 . sens_type== 12 .OR. sens_type== 13) THEN
300 sfsav = sfsav + 1
301 iparsens = 1
302 ENDIF
303 ENDDO
304 IF (iparsens == 1) stabsen = nsect+ninter+nintsub+nrwall+nrbody+1
305 END IF
306c
307 ALLOCATE(sensors%TABSENSOR(stabsen) , stat=stat)
308 ALLOCATE(sensors%FSAV(12,6,sfsav) , stat=stat)
309 sensors%STABSEN = stabsen
310 sensors%SFSAV = sfsav
311 sensors%TABSENSOR = 0
312 sensors%FSAV = zero
313
314 sensors%NSTOP = 0
315 sensors%NSTAT = 0
316 sensors%NOUTP = 0
317 sensors%NANIM = 0
318c
319 IF (iparsens == 1) THEN
320 CALL iniparsen(sensors,nsect,ninter,nintsub,nrwall,nrbody)
321 END IF
322c-----------
323 RETURN
324 END
iniparsen
subroutine iniparsen(sensors, nsect, ninter, nintsub, nrwall, nrbody)
Definition iniparsen.F:31
inisen
subroutine inisen(sensors, ipari, nom_opt, ptr_nopt_rwall, ptr_nopt_sect, ptr_nopt_inter, ixr, r_skew, numelr, nsect, ninter, nintsub, nrwall, nrbody)
Definition inisen.F:37
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
sort_logical_sensors
subroutine sort_logical_sensors(sensors)
Definition sort_logical_sensors.F:33
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895