OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inisen.F File Reference
#include "implicit_f.inc"
#include "scr17_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine inisen (sensors, ipari, nom_opt, ptr_nopt_rwall, ptr_nopt_sect, ptr_nopt_inter, ixr, r_skew, numelr, nsect, ninter, nintsub, nrwall, nrbody)

Function/Subroutine Documentation

◆ inisen()

subroutine inisen ( type (sensors_), intent(inout), target sensors,
integer, dimension(npari,ninter) ipari,
integer, dimension(lnopt1,*) nom_opt,
integer ptr_nopt_rwall,
integer ptr_nopt_sect,
integer ptr_nopt_inter,
integer, dimension(nixr,numelr) ixr,
integer, dimension(numelr) r_skew,
integer, intent(in) numelr,
integer, intent(in) nsect,
integer, intent(in) ninter,
integer, intent(in) nintsub,
integer, intent(in) nrwall,
integer, intent(in) nrbody )

Definition at line 34 of file inisen.F.

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