OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
kinset.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "scr03_c.inc"
#include "kincod_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine kinset (ik, node, ikine, idir, isk, ikine1)

Function/Subroutine Documentation

◆ kinset()

subroutine kinset ( integer ik,
integer node,
integer, dimension(*) ikine,
integer idir,
integer isk,
integer, dimension(*) ikine1 )

Definition at line 56 of file kinset.F.

57 USE message_mod
58 USE names_and_titles_mod , ONLY : ncharline
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "com04_c.inc"
67#include "scr03_c.inc"
68#include "kincod_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER IK,NODE,IDIR,ISK,IKINE(*),IKINE1(*)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 CHARACTER*200 TYPE
77 CHARACTER*20 DIRECT
78 CHARACTER(LEN=NCHARLINE) :: ERR_CATEGORY_TMP
79
80 INTEGER JWARN, ISKWT, ISKWR, ITRAN, IROTA, NK,
81 . JDIR(7), KDIR(7,3),LTYPE, LTYPEB, LDIRECT
82 INTEGER JWARN1, ISKWT1, ISKWR1, ITRAN1, IROTA1
83C-----
84 DATA jdir/1,2,4,1,2,4,7/
85 DATA kdir/1,0,1,0,1,0,1,
86 . 0,1,1,0,0,1,1,
87 . 0,0,0,1,1,1,1/
88C-----------------------------------------------------------------
89 jwarn = 0
90C
91 err_category_tmp=err_category
92 err_category='KINEMATIC CONDITIONS'
93C
94 IF(idir<=3)THEN
95C TRANSLATION
96 iskwt = ikine(1+numnod)/10
97 itran = ikine(1+numnod) - 10*iskwt
98 IF(itran==0)THEN
99C LIBRE DANS LES 3 DIRECTIONS
100 ikine(1+numnod) = jdir(idir)+10*isk
101 ELSEIF(iskwt==isk.AND.kdir(itran,idir)==0)THEN
102C LIBRE SUR LA DIRECTION DANS LE MEME SKEW
103 ikine(1+numnod) = ikine(1+numnod)+jdir(idir)
104 ELSEIF(kdir(itran,idir)==0)THEN
105 jwarn = 1
106 ikine(1+numnod) = ikine(1+numnod)+jdir(idir)
107 ELSEIF(iskwt==isk)THEN
108C FIXE SUR LA DIRECTION DANS LE MEME SKEW (ERROR)
109 jwarn = 1
110 ELSE
111 jwarn = 1
112 ENDIF
113 ELSEIF(idir<=6)THEN
114C ROTATION
115 iskwr = ikine(1+2*numnod)/10
116 irota = ikine(1+2*numnod) - 10*iskwr
117 IF(irota==0)THEN
118C LIBRE DANS LES 3 DIRECTIONS
119 ikine(1+2*numnod) = jdir(idir)+10*isk
120 ELSEIF(iskwr==isk.AND.kdir(irota,idir-3)==0)THEN
121C LIBRE SUR LA DIRECTION DANS LE MEME SKEW
122 ikine(1+2*numnod) = ikine(1+2*numnod)+jdir(idir)
123 ELSEIF(kdir(irota,idir-3)==0)THEN
124 jwarn = 1
125 ikine(1+2*numnod) = ikine(1+2*numnod)+jdir(idir)
126 ELSEIF(iskwr==isk)THEN
127C FIXE SUR LA DIRECTION DANS LE MEME SKEW (ERROR)
128 jwarn = 1
129 ELSE
130 jwarn = 1
131 ENDIF
132 ELSE
133c lagrange multipliers (IDIR = 7)
134 iskwt = ikine(1+ numnod)/10
135 iskwr = ikine(1+2*numnod)/10
136 itran = ikine(1+ numnod) - 10*iskwt
137 irota = ikine(1+2*numnod) - 10*iskwr
138 IF(itran/=0.AND.itran/=7.OR.irota/=0.AND.irota/=7) THEN
139 jwarn = 1
140 ikine(1+ numnod) = ikine(1+ numnod)+jdir(idir)
141 ikine(1+2*numnod) = ikine(1+2*numnod)+jdir(idir)
142 ELSE
143 ikine(1+ numnod) = ikine(1+ numnod)+jdir(idir)
144 ikine(1+2*numnod) = ikine(1+2*numnod)+jdir(idir)
145 ENDIF
146 ENDIF
147C---------------------------------------------------------------
148C CONDITION CINEMATIQUE INCOMPATIBLES ENTRE 2
149C ENTITES DU MEME TYPE
150C---------------------------------------------------------------
151 jwarn1 = 0
152C
153 IF(idir<=3)THEN
154C TRANSLATION
155 iskwt1 = ikine1(1+numnod)/10
156 itran1 = ikine1(1+numnod) - 10*iskwt1
157 IF(itran1==0)THEN
158C LIBRE DANS LES 3 DIRECTIONS
159 ikine1(1+numnod) = jdir(idir)+10*isk
160 ELSEIF(iskwt1==isk.AND.kdir(itran1,idir)==0)THEN
161C LIBRE SUR LA DIRECTION DANS LE MEME SKEW
162 ikine1(1+numnod) = ikine1(1+numnod)+jdir(idir)
163 ELSEIF(kdir(itran1,idir)==0)THEN
164 jwarn1 = 1
165 ikine1(1+numnod) = ikine1(1+numnod)+jdir(idir)
166 ELSEIF(iskwt1==isk)THEN
167C FIXE SUR LA DIRECTION DANS LE MEME SKEW (ERROR)
168 jwarn1 = 1
169 ELSE
170 jwarn1 = 1
171 ENDIF
172 ELSEIF(idir<=6)THEN
173C ROTATION
174 iskwr1 = ikine1(1+2*numnod)/10
175 irota1 = ikine1(1+2*numnod) - 10*iskwr1
176 IF(irota1==0)THEN
177C LIBRE DANS LES 3 DIRECTIONS
178 ikine1(1+2*numnod) = jdir(idir)+10*isk
179 ELSEIF(iskwr1==isk.AND.kdir(irota1,idir-3)==0)THEN
180C LIBRE SUR LA DIRECTION DANS LE MEME SKEW
181 ikine1(1+2*numnod) = ikine1(1+2*numnod)+jdir(idir)
182 ELSEIF(kdir(irota1,idir-3)==0)THEN
183 jwarn1 = 1
184 ikine1(1+2*numnod) = ikine1(1+2*numnod)+jdir(idir)
185 ELSEIF(iskwr1==isk)THEN
186C FIXE SUR LA DIRECTION DANS LE MEME SKEW (ERROR)
187 jwarn1 = 1
188 ELSE
189 jwarn1 = 1
190 ENDIF
191 ELSE
192C lagrange multipliers (IDIR = 7)
193 iskwt1 = ikine1(1+ numnod)/10
194 iskwr1 = ikine1(1+2*numnod)/10
195 itran1 = ikine1(1+ numnod) - 10*iskwt1
196 irota1 = ikine1(1+2*numnod) - 10*iskwr1
197 IF(itran1/=0.AND.itran1/=7.OR.irota1/=0
198 . .AND.irota1/=7) THEN
199 jwarn1 = 1
200 ikine1(1+ numnod) = ikine1(1+ numnod)+jdir(idir)
201 ikine1(1+2*numnod) = ikine1(1+2*numnod)+jdir(idir)
202 ELSE
203 ikine1(1+ numnod) = ikine1(1+ numnod)+jdir(idir)
204 ikine1(1+2*numnod) = ikine1(1+2*numnod)+jdir(idir)
205 ENDIF
206 ENDIF
207C
208C---------------------------------------------------------------
209C CONDITIONS CINEMATIQUES INCOMPATIBLES ENTRE 2
210C ENTITES DE MEME TYPE
211C
212C TYPECOND(IKINE(1+3*NUMNOD)) = 1
213C SI AU MOINS 2 CONDITIONS DE TYPE TYPCOND SUR CE NOEUD
214C---------------------------------------------------------------
215 IF (jwarn1 == 1) THEN
216 IF(ik==1)THEN
217 IF(ibc(ikine(1))== 1 .AND. ibc(ikine(1+3*numnod))== 0)
218 . ikine(1+3*numnod) = ikine(1+3*numnod) + 1
219 ELSEIF(ik==2)THEN ! interface
220 IF(itf(ikine(1))== 1 .AND. itf(ikine(1+3*numnod))== 0)
221 . ikine(1+3*numnod) = ikine(1+3*numnod) + 2
222 ELSEIF(ik==4)THEN
223 IF(iwl(ikine(1))== 1 .AND. iwl(ikine(1+3*numnod))== 0)
224 . ikine(1+3*numnod) = ikine(1+3*numnod) + 4
225 ELSEIF(ik==8)THEN
226 IF(irb(ikine(1))== 1 .AND. irb(ikine(1+3*numnod))== 0)
227 . ikine(1+3*numnod) = ikine(1+3*numnod) + 8
228 ELSEIF(ik==16)THEN
229 IF(ivf(ikine(1))== 1 .AND. ivf(ikine(1+3*numnod))== 0)
230 . ikine(1+3*numnod) = ikine(1+3*numnod) + 16
231 ELSEIF(ik==32)THEN
232 IF(irv(ikine(1))== 1 .AND. irv(ikine(1+3*numnod))== 0)
233 . ikine(1+3*numnod) = ikine(1+3*numnod) + 32
234 ELSEIF(ik==64)THEN
235 IF(ijo(ikine(1))== 1 .AND. ijo(ikine(1+3*numnod))== 0)
236 . ikine(1+3*numnod) = ikine(1+3*numnod) + 64
237 ELSEIF(ik==128)THEN
238 IF(irb2(ikine(1))== 1 .AND. irb2(ikine(1+3*numnod))== 0)
239 . ikine(1+3*numnod) = ikine(1+3*numnod) + 128
240 ELSEIF(ik==256)THEN
241 IF(irbm(ikine(1))== 1 .AND. irbm(ikine(1+3*numnod))== 0)
242 . ikine(1+3*numnod) = ikine(1+3*numnod) + 256
243 ELSEIF(ik==512)THEN
244 IF(ilmult(ikine(1))==1.AND.ilmult(ikine(1+3*numnod))==0)
245 . ikine(1+3*numnod) = ikine(1+3*numnod) + 512
246 ELSEIF(ik==1024)THEN
247 IF(irlk(ikine(1))== 1 .AND. irlk(ikine(1+3*numnod))== 0)
248 . ikine(1+3*numnod) = ikine(1+3*numnod) + 1024
249 ELSEIF(ik==2048)THEN
250 IF(ikrbe2(ikine(1))==1.AND.ikrbe2(ikine(1+3*numnod))== 0)
251 . ikine(1+3*numnod) = ikine(1+3*numnod) + 2048
252 ELSEIF(ik==4096)THEN
253 IF(ikrbe3(ikine(1))==1.AND.ikrbe3(ikine(1+3*numnod))== 0)
254 . ikine(1+3*numnod) = ikine(1+3*numnod) + 4096
255 ENDIF
256 ENDIF
257C---------------------------------------------------------------
258C CONDITIONS CINEMATIQUES INCOMPATIBLES ENTRE 2
259C ENTITES DE TYPES DIFFERENTS
260C
261C SI IKINE(1+4*NUMNOD) = 0 : PAS DE CONDITIONS INCOMPATIBLES
262C DE DIFFERENTS TYPES SUR CE NOEUD
263C---------------------------------------------------------------
264 IF(ik==1)THEN
265 IF(ibc(ikine(1))==0 .AND. ibc(ikine(1+4*numnod))==0
266 . .AND. jwarn==1)
267 . ikine(1+4*numnod) = ikine(1+4*numnod) + 1
268 ELSEIF(ik==2)THEN
269 IF(itf(ikine(1))==0 .AND. itf(ikine(1+4*numnod))==0
270 . .AND. jwarn==1)
271 . ikine(1+4*numnod) = ikine(1+4*numnod) + 2
272 ELSEIF(ik==4)THEN
273 IF(iwl(ikine(1))==0 .AND. iwl(ikine(1+4*numnod))==0
274 . .AND. jwarn==1)
275 . ikine(1+4*numnod) = ikine(1+4*numnod) + 4
276 ELSEIF(ik==8)THEN
277 IF(irb(ikine(1))==0 .AND. irb(ikine(1+4*numnod))==0
278 . .AND. jwarn==1)
279 . ikine(1+4*numnod) = ikine(1+4*numnod) + 8
280 ELSEIF(ik==16)THEN
281 IF(ivf(ikine(1))==0 .AND. ivf(ikine(1+4*numnod))==0
282 . .AND. jwarn==1)
283 . ikine(1+4*numnod) = ikine(1+4*numnod) + 16
284 ELSEIF(ik==32)THEN
285 IF(irv(ikine(1))==0 .AND. irv(ikine(1+4*numnod))==0
286 . .AND. jwarn==1)
287 . ikine(1+4*numnod) = ikine(1+4*numnod) + 32
288 ELSEIF(ik==64)THEN
289 IF(ijo(ikine(1))==0 .AND. ijo(ikine(1+4*numnod))==0
290 . .AND. jwarn==1)
291 . ikine(1+4*numnod) = ikine(1+4*numnod) + 64
292 ELSEIF(ik==128)THEN
293 IF(irb2(ikine(1))==0 .AND. irb2(ikine(1+4*numnod))==0
294 . .AND. jwarn==1)
295 . ikine(1+4*numnod) = ikine(1+4*numnod) + 128
296 ELSEIF(ik==256)THEN
297 IF(irbm(ikine(1))==0 .AND. irbm(ikine(1+4*numnod))==0
298 . .AND. jwarn==1)
299 . ikine(1+4*numnod) = ikine(1+4*numnod) + 256
300 ELSEIF(ik==512)THEN
301 IF(ilmult(ikine(1))==0 .AND. ilmult(ikine(1+4*numnod))==0
302 . .AND. jwarn==1)
303 . ikine(1+4*numnod)=ikine(1+4*numnod) + 512
304 ELSEIF(ik==1024)THEN
305 IF(irlk(ikine(1))==0 .AND. irlk(ikine(1+4*numnod))==0
306 . .AND. jwarn==1)
307 . ikine(1+4*numnod)=ikine(1+4*numnod) + 1024
308 ELSEIF(ik==2048)THEN
309 IF(ikrbe2(ikine(1))==0 .AND. ikrbe2(ikine(1+4*numnod))==0
310 . .AND. jwarn==1)
311 . ikine(1+4*numnod)=ikine(1+4*numnod) + 2048
312 ELSEIF(ik==4096)THEN
313 IF(ikrbe3(ikine(1))==0 .AND. ikrbe3(ikine(1+4*numnod))==0
314 . .AND. jwarn==1)
315 . ikine(1+4*numnod)=ikine(1+4*numnod) + 4096
316 ENDIF
317C
318 IF(ik==1)THEN
319 IF(ibc(ikine(1))==0)ikine(1) = ikine(1) + 1
320 ELSEIF(ik==2)THEN
321 IF(itf(ikine(1))==0)ikine(1) = ikine(1) + 2
322 ELSEIF(ik==4)THEN
323 IF(iwl(ikine(1))==0)ikine(1) = ikine(1) + 4
324 ELSEIF(ik==8)THEN
325 IF(irb(ikine(1))==0)ikine(1) = ikine(1) + 8
326 ELSEIF(ik==16)THEN
327 IF(ivf(ikine(1))==0)ikine(1) = ikine(1) + 16
328 ELSEIF(ik==32)THEN
329 IF(irv(ikine(1))==0)ikine(1) = ikine(1) + 32
330 ELSEIF(ik==64)THEN
331 IF(ijo(ikine(1))==0)ikine(1) = ikine(1) + 64
332 ELSEIF(ik==128)THEN
333 IF(irb2(ikine(1))==0)ikine(1) = ikine(1) + 128
334 ELSEIF(ik==256)THEN
335 IF(irbm(ikine(1))==0)ikine(1) = ikine(1) + 256
336 ELSEIF(ik==512)THEN
337 IF(ilmult(ikine(1))==0)ikine(1)=ikine(1) + 512
338 ELSEIF(ik==1024)THEN
339 IF(irlk(ikine(1))==0)ikine(1)=ikine(1) + 1024
340 ELSEIF(ik==2048)THEN
341 IF(ikrbe2(ikine(1))==0)ikine(1)=ikine(1) + 2048
342 ELSEIF(ik==4096)THEN
343 IF(ikrbe3(ikine(1))==0)ikine(1)=ikine(1) + 4096
344 ENDIF
345C
346 nk = ibc(ikine(1))+itf(ikine(1))+iwl(ikine(1))+
347 . irb(ikine(1))+irb2(ikine(1))+
348 . ivf(ikine(1))+irv(ikine(1))+ijo(ikine(1))+
349 . irbm(ikine(1))+ilmult(ikine(1))+irlk(ikine(1))+
350 . ikrbe2(ikine(1))+ikrbe3(ikine(1))
351 IF(nk==1)nk=2
352C
353 IF (iwl(ikine(1))/=1 .OR. irb(ikine(1))/=1) THEN
354 kwarn = kwarn + jwarn
355 ENDIF
356C
357 IF(jwarn==1)THEN
358C
359 ltype = 0
360 TYPE = ' '
361C
362C WARNING WHILE ADDING AN OPTION : TYPE MUST BE LONG ENOUGH
363C
364 IF(ibc(ikine(1))==1) THEN
365 ltypeb = 20
366 TYPE((LTYPE+1):(LTYPE+1+LTYPEB)) = '-BOUNDARY CONDITION'
367 ltype = ltype + ltypeb
368 ENDIF
369 IF(itf(ikine(1))==1) THEN
370 ltypeb = 27
371 TYPE((LTYPE+1):(LTYPE+1+LTYPEB))=
372 . '-INTERFACE TYPE 1 2 12 OR 9'
373 ltype = ltype + ltypeb
374 ENDIF
375 IF(iwl(ikine(1))==1) THEN
376 ltypeb = 12
377 TYPE((LTYPE+1):(LTYPE+1+LTYPEB)) = '-RIGID WALL'
378 ltype = ltype + ltypeb
379 ENDIF
380 IF(irb(ikine(1))==1) THEN
381 ltypeb = 12
382 TYPE((LTYPE+1):(LTYPE+1+LTYPEB)) = '-RIGID BODY'
383 ltype = ltype + ltypeb
384 ENDIF
385 IF(irb2(ikine(1))==1) THEN
386 ltypeb = 12
387 TYPE((LTYPE+1):(LTYPE+1+LTYPEB))='-RIGID BODY'
388 ltype = ltype + ltypeb
389 ENDIF
390 IF(ivf(ikine(1))==1) THEN
391 ltypeb = 29
392 TYPE((LTYPE+1):(LTYPE+1+LTYPEB))=
393 . '-FIXED VELOCITY/DISPLACEMENT'
394 ltype = ltype + ltypeb
395 ENDIF
396 IF(irv(ikine(1))==1) THEN
397 ltypeb = 7
398 TYPE((LTYPE+1):(LTYPE+1+LTYPEB))='-RIVET'
399 ltype = ltype + ltypeb
400 ENDIF
401 IF(ijo(ikine(1))==1) THEN
402 ltypeb = 19
403 TYPE((LTYPE+1):(LTYPE+1+LTYPEB))='-CYLINDRICAL JOINT'
404 ltype = ltype + ltypeb
405 ENDIF
406 IF(irbm(ikine(1))==1) THEN
407 ltypeb = 23
408 TYPE((LTYPE+1):(LTYPE+1+LTYPEB))='-IMPOSED BODY VELOCITY'
409 ltype = ltype + ltypeb
410 ENDIF
411 IF(ilmult(ikine(1))==1) THEN
412 ltypeb = 22
413 TYPE((LTYPE+1):(LTYPE+1+LTYPEB))='-LAGRANGE MULTIPLIERS'
414 ltype = ltype + ltypeb
415 ENDIF
416 IF(irlk(ikine(1))==1) THEN
417 ltypeb =12
418 TYPE((LTYPE+1):(LTYPE+1+LTYPEB))='-RIGID LINK'
419 ltype = ltype + ltypeb
420 ENDIF
421 IF(ikrbe2(ikine(1))==1) THEN
422 ltypeb =6
423 TYPE((LTYPE+1):(LTYPE+1+LTYPEB))='-RBE2'
424 ltype = ltype + ltypeb
425 ENDIF
426 IF(ikrbe3(ikine(1))==1) THEN
427 ltypeb =6
428 TYPE((LTYPE+1):(LTYPE+1+LTYPEB))='-RBE3'
429 ltype = ltype + ltypeb
430 ENDIF
431C
432 IF (idir == 1) THEN
433 direct = 'TRANSLATION X'
434 ldirect = 13
435 ELSE IF (idir == 2) THEN
436 direct = 'TRANSLATION Y'
437 ldirect = 13
438 ELSE IF (idir == 3) THEN
439 direct = 'TRANSLATION Z'
440 ldirect = 13
441 ELSE IF (idir == 4) THEN
442 direct = 'ROTATION X'
443 ldirect = 10
444 ELSE IF (idir == 5) THEN
445 direct = 'ROTATION Y'
446 ldirect = 10
447 ELSE IF (idir == 6) THEN
448 direct = 'ROTATION Z'
449 ldirect = 10
450 ELSE
451 direct = 'UNKNOWN'
452 ldirect = 7
453 ENDIF
454C
455 IF ((iwl(ikine(1))/=1 .OR. irb(ikine(1))/=1) .AND.
456 . ipri >= 5) THEN
457C
458C ANINFO_BLIND_2 : Print Nothing on screen, title + description in file
459 CALL ancmsg(msgid=147,
460 . msgtype=msgwarning,
461 . anmode=aninfo_blind_2,
462 . i1=nk,
463 . i2=node,
464 . c1= direct,
465 . c2= type)
466C
467 ENDIF
468 ENDIF
469c
470 err_category=err_category_tmp
471c-----------
472 RETURN
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
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