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 FREE IN 3 DIRECTIONS
100 ikine(1+numnod) = jdir(idir)+10*isk
101 ELSEIF(iskwt==isk.AND.kdir(itran,idir)==0)THEN
102C FREE IN THE DIRECTION OF THE SAME 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 FIXED IN THE DIRECTION OF THE SAME 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 FREE IN 3 DIRECTIONS
119 ikine(1+2*numnod) = jdir(idir)+10*isk
120 ELSEIF(iskwr==isk.AND.kdir(irota,idir-3)==0)THEN
121C FREE IN THE DIRECTION OF THE SAME 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 FIXED IN THE DIRECTION OF THE SAME 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 INCOMPATIBLE KINEMATIC CONDITIONS BETWEEN 2
149C ENTITIES OF THE SAME 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 FREE IN 3 DIRECTIONS
159 ikine1(1+numnod) = jdir(idir)+10*isk
160 ELSEIF(iskwt1==isk.AND.kdir(itran1,idir)==0)THEN
161C FREE IN THE DIRECTION OF THE SAME 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 FIXED IN THE DIRECTION OF THE SAME 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 FREE IN 3 DIRECTIONS
178 ikine1(1+2*numnod) = jdir(idir)+10*isk
179 ELSEIF(iskwr1==isk.AND.kdir(irota1,idir-3)==0)THEN
180C free in the direction within the same 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 fixed in the direction within the same 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 INCOMPATIBLE KINEMATIC CONDITIONS BETWEEN 2
210C entities of the same type
211C
212C TYPECOND(IKINE(1+3*NUMNOD)) = 1
213C if at least 2 conditions of type typcond on this node
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 INCOMPATIBLE KINEMATIC CONDITIONS BETWEEN 2
259C entities of different types
260C
261C IF IKINE(1+4*NUMNOD) = 0 : NO INCOMPATIBLE CONDITIONS
262C of different types on this node
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.OR..AND. IF ((IWL(IKINE(1))/=1 IRB(IKINE(1))/=1)
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:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1006
velocity
subroutine velocity(a, ar, v, vr, fzero, itab, nale)
Definition velocity.F:29