OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ini_gear.F File Reference
#include "implicit_f.inc"
#include "lagmult.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine ini_gear (iadll, jll, lll, n0, n1, n2, nc, id, titr)

Function/Subroutine Documentation

◆ ini_gear()

subroutine ini_gear ( integer, dimension(*) iadll,
integer, dimension(*) jll,
integer, dimension(*) lll,
integer n0,
integer n1,
integer n2,
integer nc,
integer id,
character(len=nchartitle) titr )

Definition at line 32 of file ini_gear.F.

34 USE message_mod
35 USE names_and_titles_mod , ONLY : nchartitle
36C----------------------------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "lagmult.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER N0, N1, N2, NC, IADLL(*), JLL(*), LLL(*)
48 INTEGER ID
49 CHARACTER(LEN=NCHARTITLE) :: TITR
50C-----------------------------------------------
51C L o c a l V a r i a b l e s
52C-----------------------------------------------
53 INTEGER IK, IAD
54C======================================================================|
55C --- VM_x
56 nc = nc + 1
57 IF(nc>lag_ncf)THEN
58 CALL ancmsg(msgid=468,
59 . msgtype=msgerror,
60 . anmode=aninfo,
61 . i1=id,
62 . c1='GEAR JOINT',
63 . c2='GEAR JOINT',
64 . c3=titr)
65 ENDIF
66 iadll(nc+1)=iadll(nc) + 5
67 IF(iadll(nc+1)-1>lag_nkf)THEN
68 CALL ancmsg(msgid=469,
69 . msgtype=msgerror,
70 . anmode=aninfo,
71 . i1=id,
72 . c1='GEAR JOINT',
73 . c2='GEAR JOINT',
74 . c3=titr)
75 ENDIF
76 ik = iadll(nc)
77 lll(ik) = n0
78 jll(ik) = 1
79 ik = ik+1
80 lll(ik) = n1
81 jll(ik) = 1
82 ik = ik+1
83 lll(ik) = n2
84 jll(ik) = 1
85 ik = ik+1
86 lll(ik) = n0
87 jll(ik) = 5
88 ik = ik+1
89 lll(ik) = n0
90 jll(ik) = 6
91C
92C --- VM_x
93 nc = nc + 1
94 IF(nc>lag_ncf)THEN
95 CALL ancmsg(msgid=468,
96 . msgtype=msgerror,
97 . anmode=aninfo,
98 . i1=id,
99 . c1='GEAR JOINT',
100 . c2='GEAR JOINT',
101 . c3=titr)
102 ENDIF
103 iadll(nc+1)=iadll(nc) + 5
104 IF(iadll(nc+1)-1>lag_nkf)THEN
105 CALL ancmsg(msgid=469,
106 . msgtype=msgerror,
107 . anmode=aninfo,
108 . i1=id,
109 . c1='GEAR JOINT',
110 . c2='GEAR JOINT',
111 . c3=titr)
112 ENDIF
113 ik = iadll(nc)
114 lll(ik) = n0
115 jll(ik) = 2
116 ik = ik+1
117 lll(ik) = n1
118 jll(ik) = 2
119 ik = ik+1
120 lll(ik) = n2
121 jll(ik) = 2
122 ik = ik+1
123 lll(ik) = n0
124 jll(ik) = 6
125 ik = ik+1
126 lll(ik) = n0
127 jll(ik) = 4
128C
129C --- VM_z
130 nc = nc + 1
131 IF(nc>lag_ncf)THEN
132 CALL ancmsg(msgid=468,
133 . msgtype=msgerror,
134 . anmode=aninfo,
135 . i1=id,
136 . c1='GEAR JOINT',
137 . c2='GEAR JOINT',
138 . c3=titr)
139 ENDIF
140 iadll(nc+1)=iadll(nc) + 5
141 IF(iadll(nc+1)-1>lag_nkf)THEN
142 CALL ancmsg(msgid=469,
143 . msgtype=msgerror,
144 . anmode=aninfo,
145 . i1=id,
146 . c1='GEAR JOINT',
147 . c2='GEAR JOINT',
148 . c3=titr)
149 ENDIF
150 ik = iadll(nc)
151 lll(ik) = n0
152 jll(ik) = 3
153 ik = ik+1
154 lll(ik) = n1
155 jll(ik) = 3
156 ik = ik+1
157 lll(ik) = n2
158 jll(ik) = 3
159 ik = ik+1
160 lll(ik) = n0
161 jll(ik) = 4
162 ik = ik+1
163 lll(ik) = n0
164 jll(ik) = 5
165C
166C --- V1_x
167 nc = nc + 1
168 IF(nc>lag_ncf)THEN
169 CALL ancmsg(msgid=468,
170 . msgtype=msgerror,
171 . anmode=aninfo,
172 . i1=id,
173 . c1='GEAR JOINT',
174 . c2='GEAR JOINT',
175 . c3=titr)
176 ENDIF
177 iadll(nc+1)=iadll(nc) + 4
178 IF(iadll(nc+1)-1>lag_nkf)THEN
179 CALL ancmsg(msgid=469,
180 . msgtype=msgerror,
181 . anmode=aninfo,
182 . i1=id,
183 . c1='GEAR JOINT',
184 . c2='GEAR JOINT',
185 . c3=titr)
186 ENDIF
187 ik = iadll(nc)
188 lll(ik) = n1
189 jll(ik) = 1
190 ik = ik+1
191 lll(ik) = n2
192 jll(ik) = 1
193 ik = ik+1
194 lll(ik) = n0
195 jll(ik) = 5
196 ik = ik+1
197 lll(ik) = n0
198 jll(ik) = 6
199C
200C --- V1_y
201 nc = nc + 1
202 IF(nc>lag_ncf)THEN
203 CALL ancmsg(msgid=468,
204 . msgtype=msgerror,
205 . anmode=aninfo,
206 . i1=id,
207 . c1='GEAR JOINT',
208 . c2='GEAR JOINT',
209 . c3=titr)
210 ENDIF
211 iadll(nc+1)=iadll(nc) + 4
212 IF(iadll(nc+1)-1>lag_nkf)THEN
213 CALL ancmsg(msgid=469,
214 . msgtype=msgerror,
215 . anmode=aninfo,
216 . i1=id,
217 . c1='GEAR JOINT',
218 . c2='GEAR JOINT',
219 . c3=titr)
220 ENDIF
221 ik = iadll(nc)
222 lll(ik) = n1
223 jll(ik) = 2
224 ik = ik+1
225 lll(ik) = n2
226 jll(ik) = 2
227 ik = ik+1
228 lll(ik) = n0
229 jll(ik) = 6
230 ik = ik+1
231 lll(ik) = n0
232 jll(ik) = 4
233C
234C --- V1_z
235 nc = nc + 1
236 IF(nc>lag_ncf)THEN
237 CALL ancmsg(msgid=468,
238 . msgtype=msgerror,
239 . anmode=aninfo,
240 . i1=id,
241 . c1='GEAR JOINT',
242 . c2='GEAR JOINT',
243 . c3=titr)
244 ENDIF
245 iadll(nc+1)=iadll(nc) + 4
246 IF(iadll(nc+1)-1>lag_nkf)THEN
247 CALL ancmsg(msgid=469,
248 . msgtype=msgerror,
249 . anmode=aninfo,
250 . i1=id,
251 . c1='GEAR JOINT',
252 . c2='GEAR JOINT',
253 . c3=titr)
254 ENDIF
255 ik = iadll(nc)
256 lll(ik) = n1
257 jll(ik) = 3
258 ik = ik+1
259 lll(ik) = n2
260 jll(ik) = 3
261 ik = ik+1
262 lll(ik) = n0
263 jll(ik) = 4
264 ik = ik+1
265 lll(ik) = n0
266 jll(ik) = 5
267C
268C Local Constraints
269 nc = nc + 1
270 IF(nc>lag_ncf)THEN
271 CALL ancmsg(msgid=468,
272 . msgtype=msgerror,
273 . anmode=aninfo,
274 . i1=id,
275 . c1='GEAR JOINT',
276 . c2='GEAR JOINT',
277 . c3=titr)
278 ENDIF
279 iadll(nc+1)=iadll(nc) + 9
280 IF(iadll(nc+1)-1>lag_nkf)THEN
281 CALL ancmsg(msgid=469,
282 . msgtype=msgerror,
283 . anmode=aninfo,
284 . i1=id,
285 . c1='GEAR JOINT',
286 . c2='gear joint',
287 . C3=TITR)
288 ENDIF
289 IK = IADLL(NC)
290 LLL(IK) = N1
291 JLL(IK) = 4
292 IK = IK+1
293 LLL(IK) = N1
294 JLL(IK) = 5
295 IK = IK+1
296 LLL(IK) = N1
297 JLL(IK) = 6
298c
299 IK = IK+1
300 LLL(IK) = N2
301 JLL(IK) = 4
302 IK = IK+1
303 LLL(IK) = N2
304 JLL(IK) = 5
305 IK = IK+1
306 LLL(IK) = N2
307 JLL(IK) = 6
308c
309 IK = IK+1
310 LLL(IK) = N0
311 JLL(IK) = 4
312 IK = IK+1
313 LLL(IK) = N0
314 JLL(IK) = 5
315 IK = IK+1
316 LLL(IK) = N0
317 JLL(IK) = 6
318C
319C local Y
320 NC = NC + 1
321 IF(NC>LAG_NCF)THEN
322 CALL ANCMSG(MSGID=468,
323 . MSGTYPE=MSGERROR,
324 . ANMODE=ANINFO,
325 . I1=ID,
326 . C1='gear joint',
327 . C2='gear joint',
328 . C3=TITR)
329 ENDIF
330 IADLL(NC+1)=IADLL(NC) + 6
331 IF(IADLL(NC+1)-1>LAG_NKF)THEN
332 CALL ANCMSG(MSGID=469,
333 . MSGTYPE=MSGERROR,
334 . ANMODE=ANINFO,
335 . I1=ID,
336 . C1='gear joint',
337 . C2='gear joint',
338 . C3=TITR)
339 ENDIF
340 IK = IADLL(NC)
341 LLL(IK) = N1
342 JLL(IK) = 4
343 IK = IK+1
344 LLL(IK) = N1
345 JLL(IK) = 5
346 IK = IK+1
347 LLL(IK) = N1
348 JLL(IK) = 6
349 IK = IK+1
350 LLL(IK) = N0
351 JLL(IK) = 4
352 IK = IK+1
353 LLL(IK) = N0
354 JLL(IK) = 5
355 IK = IK+1
356 LLL(IK) = N0
357 JLL(IK) = 6
358C
359C local Z
360 NC = NC + 1
361 IF(NC>LAG_NCF)THEN
362 CALL ANCMSG(MSGID=468,
363 . MSGTYPE=MSGERROR,
364 . ANMODE=ANINFO,
365 . I1=ID,
366 . C1='gear joint',
367 . C2='gear joint',
368 . C3=TITR)
369 ENDIF
370 IADLL(NC+1)=IADLL(NC) + 6
371 IF(IADLL(NC+1)-1>LAG_NKF)THEN
372 CALL ANCMSG(MSGID=469,
373 . MSGTYPE=MSGERROR,
374 . ANMODE=ANINFO,
375 . I1=ID,
376 . C1='gear joint',
377 . C2='gear joint',
378 . C3=TITR)
379 ENDIF
380 IK = IADLL(NC)
381 LLL(IK) = N1
382 JLL(IK) = 4
383 IK = IK+1
384 LLL(IK) = N1
385 JLL(IK) = 5
386 IK = IK+1
387 LLL(IK) = N1
388 JLL(IK) = 6
389 IK = IK+1
390 LLL(IK) = N0
391 JLL(IK) = 4
392 IK = IK+1
393 LLL(IK) = N0
394 JLL(IK) = 5
395 IK = IK+1
396 LLL(IK) = N0
397 JLL(IK) = 6
398C
399C N2 - local Y
400 NC = NC + 1
401 IF(NC>LAG_NCF)THEN
402 CALL ANCMSG(MSGID=468,
403 . MSGTYPE=MSGERROR,
404 . ANMODE=ANINFO,
405 . I1=ID,
406 . C1='gear joint',
407 . C2='gear joint',
408 . C3=TITR)
409 ENDIF
410 IADLL(NC+1)=IADLL(NC) + 6
411 IF(IADLL(NC+1)-1>LAG_NKF)THEN
412 CALL ANCMSG(MSGID=469,
413 . MSGTYPE=MSGERROR,
414 . ANMODE=ANINFO,
415 . I1=ID,
416 . C1='gear joint',
417 . C2='gear joint',
418 . C3=TITR)
419 ENDIF
420 IK = IADLL(NC)
421 LLL(IK) = N2
422 JLL(IK) = 4
423 IK = IK+1
424 LLL(IK) = N2
425 JLL(IK) = 5
426 IK = IK+1
427 LLL(IK) = N2
428 JLL(IK) = 6
429 IK = IK+1
430 LLL(IK) = N0
431 JLL(IK) = 4
432 IK = IK+1
433 LLL(IK) = N0
434 JLL(IK) = 5
435 IK = IK+1
436 LLL(IK) = N0
437 JLL(IK) = 6
438C
439C N2 - local Z
440 NC = NC + 1
441 IF(NC>LAG_NCF)THEN
442 CALL ANCMSG(MSGID=468,
443 . MSGTYPE=MSGERROR,
444 . ANMODE=ANINFO,
445 . I1=ID,
446 . C1='gear joint',
447 . C2='gear joint',
448 . C3=TITR)
449 ENDIF
450 IADLL(NC+1)=IADLL(NC) + 6
451 IF(IADLL(NC+1)-1>LAG_NKF)THEN
452 CALL ANCMSG(MSGID=469,
453 . MSGTYPE=MSGERROR,
454 . ANMODE=ANINFO,
455 . I1=ID,
456 . C1='gear joint',
457 . C2='gear joint',
458 . C3=TITR)
459 ENDIF
460 IK = IADLL(NC)
461 LLL(IK) = N2
462 JLL(IK) = 4
463 IK = IK+1
464 LLL(IK) = N2
465 JLL(IK) = 5
466 IK = IK+1
467 LLL(IK) = N2
468 JLL(IK) = 6
469 IK = IK+1
470 LLL(IK) = N0
471 JLL(IK) = 4
472 IK = IK+1
473 LLL(IK) = N0
474 JLL(IK) = 5
475 IK = IK+1
476 LLL(IK) = N0
477 JLL(IK) = 6
478C---
479 RETURN
id
initmumps id
Definition multiplerhs_example.m:4
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
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