OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ini_diff.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!|| ini_diff ../starter/source/tools/lagmul/ini_diff.F
25!||--- called by ------------------------------------------------------
26!|| lgmini_gj ../starter/source/tools/lagmul/lgmini_gj.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!||--- uses -----------------------------------------------------
30!|| message_mod ../starter/share/message_module/message_mod.F
31!||====================================================================
32 SUBROUTINE ini_diff(IADLL ,JLL ,LLL ,N0 ,N1 ,
33 . N2 ,N3 ,NC,ID,TITR)
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, N3 ,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 I, JJ, IK, IAD, INOD(4)
54C======================================================================|
55 inod(1) = n1
56 inod(2) = n2
57 inod(3) = n3
58 inod(4) = n0
59C--- vx
60 nc = nc + 1
61 IF(nc>lag_ncf)THEN
62 CALL ancmsg(msgid=468,
63 . msgtype=msgerror,
64 . anmode=aninfo,
65 . i1=id,
66 . c1='DIFFERENTIAL GEAR',
67 . c2='DIFFERENTIAL GEAR',
68 . c3=titr)
69 ENDIF
70 iadll(nc+1) = iadll(nc) + 10
71 IF(iadll(nc+1)-1>lag_nkf)THEN
72 CALL ancmsg(msgid=469,
73 . msgtype=msgerror,
74 . anmode=aninfo,
75 . i1=id,
76 . c1='DIFFERENTIAL GEAR',
77 . c2='DIFFERENTIAL GEAR',
78 . c3=titr)
79 ENDIF
80 iad = iadll(nc) -1
81 DO jj=1,3
82 ik = iad+jj
83 lll(ik) = inod(jj)
84 jll(ik) = 1
85 ENDDO
86 iad = iad + 3
87 DO jj=1,3
88 ik = iad+jj
89 lll(ik) = inod(jj)
90 jll(ik) = 2
91 ENDDO
92 iad = iad + 3
93 DO jj=1,3
94 ik = iad+jj
95 lll(ik) = inod(jj)
96 jll(ik) = 3
97 ENDDO
98 ik = iad + 4
99 lll(ik) = inod(4)
100 jll(ik) = 1
101C--- vy
102 nc = nc + 1
103 IF(nc>lag_ncf)THEN
104 CALL ancmsg(msgid=468,
105 . msgtype=msgerror,
106 . anmode=aninfo,
107 . i1=id,
108 . c1='DIFFERENTIAL GEAR',
109 . c2='DIFFERENTIAL GEAR',
110 . c3=titr)
111 ENDIF
112 iadll(nc+1) = iadll(nc) + 10
113 IF(iadll(nc+1)-1>lag_nkf)THEN
114 CALL ancmsg(msgid=469,
115 . msgtype=msgerror,
116 . anmode=aninfo,
117 . i1=id,
118 . c1='DIFFERENTIAL GEAR',
119 . c2='DIFFERENTIAL GEAR',
120 . c3=titr)
121 ENDIF
122 iad = iadll(nc) -1
123 DO jj=1,3
124 ik = iad+jj
125 lll(ik) = inod(jj)
126 jll(ik) = 1
127 ENDDO
128 iad = iad + 3
129 DO jj=1,3
130 ik = iad+jj
131 lll(ik) = inod(jj)
132 jll(ik) = 2
133 ENDDO
134 iad = iad + 3
135 DO jj=1,3
136 ik = iad+jj
137 lll(ik) = inod(jj)
138 jll(ik) = 3
139 ENDDO
140 ik = iad + 4
141 lll(ik) = inod(4)
142 jll(ik) = 2
143C--- vz
144 nc = nc + 1
145 IF(nc>lag_ncf)THEN
146 CALL ancmsg(msgid=468,
147 . msgtype=msgerror,
148 . anmode=aninfo,
149 . i1=id,
150 . c1='DIFFERENTIAL GEAR',
151 . c2='DIFFERENTIAL GEAR',
152 . c3=titr)
153 ENDIF
154 iadll(nc+1) = iadll(nc) + 10
155 IF(iadll(nc+1)-1>lag_nkf)THEN
156 CALL ancmsg(msgid=469,
157 . msgtype=msgerror,
158 . anmode=aninfo,
159 . i1=id,
160 . c1='DIFFERENTIAL GEAR',
161 . c2='DIFFERENTIAL GEAR',
162 . c3=titr)
163 ENDIF
164 iad = iadll(nc) -1
165 DO jj=1,3
166 ik = iad+jj
167 lll(ik) = inod(jj)
168 jll(ik) = 1
169 ENDDO
170 iad = iad + 3
171 DO jj=1,3
172 ik = iad+jj
173 lll(ik) = inod(jj)
174 jll(ik) = 2
175 ENDDO
176 iad = iad + 3
177 DO jj=1,3
178 ik = iad+jj
179 lll(ik) = inod(jj)
180 jll(ik) = 3
181 ENDDO
182 ik = iad + 4
183 lll(ik) = inod(4)
184 jll(ik) = 3
185C --- wx
186 nc = nc + 1
187 IF(nc>lag_ncf)THEN
188 CALL ancmsg(msgid=468,
189 . msgtype=msgerror,
190 . anmode=aninfo,
191 . i1=id,
192 . c1='DIFFERENTIAL GEAR',
193 . c2='DIFFERENTIAL GEAR',
194 . c3=titr)
195 ENDIF
196 iadll(nc+1) = iadll(nc) + 10
197 IF(iadll(nc+1)-1>lag_nkf)THEN
198 CALL ancmsg(msgid=469,
199 . msgtype=msgerror,
200 . anmode=aninfo,
201 . i1=id,
202 . c1='DIFFERENTIAL GEAR',
203 . c2='DIFFERENTIAL GEAR',
204 . c3=titr)
205 ENDIF
206 iad = iadll(nc) -1
207 DO jj=1,3
208 ik = iad+jj
209 lll(ik) = inod(jj)
210 jll(ik) = 1
211 ENDDO
212 iad = iad + 3
213 DO jj=1,3
214 ik = iad+jj
215 lll(ik) = inod(jj)
216 jll(ik) = 2
217 ENDDO
218 iad = iad + 3
219 DO jj=1,3
220 ik = iad+jj
221 lll(ik) = inod(jj)
222 jll(ik) = 3
223 ENDDO
224 ik = iad + 4
225 lll(ik) = inod(4)
226 jll(ik) = 4
227C --- wy
228 nc = nc + 1
229 IF(nc>lag_ncf)THEN
230 CALL ancmsg(msgid=468,
231 . msgtype=msgerror,
232 . anmode=aninfo,
233 . i1=id,
234 . c1='DIFFERENTIAL GEAR',
235 . c2='DIFFERENTIAL GEAR',
236 . c3=titr)
237 ENDIF
238 iadll(nc+1) = iadll(nc) + 10
239 IF(iadll(nc+1)-1>lag_nkf)THEN
240 CALL ancmsg(msgid=469,
241 . msgtype=msgerror,
242 . anmode=aninfo,
243 . i1=id,
244 . c1='DIFFERENTIAL GEAR',
245 . c2='DIFFERENTIAL GEAR',
246 . c3=titr)
247 ENDIF
248 iad = iadll(nc) -1
249 DO jj=1,3
250 ik = iad+jj
251 lll(ik) = inod(jj)
252 jll(ik) = 1
253 ENDDO
254 iad = iad + 3
255 DO jj=1,3
256 ik = iad+jj
257 lll(ik) = inod(jj)
258 jll(ik) = 2
259 ENDDO
260 iad = iad + 3
261 DO jj=1,3
262 ik = iad+jj
263 lll(ik) = inod(jj)
264 jll(ik) = 3
265 ENDDO
266 ik = iad + 4
267 lll(ik) = inod(4)
268 jll(ik) = 5
269C --- wz
270 nc = nc + 1
271 IF(nc>lag_ncf)THEN
272 CALL ancmsg(msgid=468,
273 . msgtype=msgerror,
274 . anmode=aninfo,
275 . i1=id,
276 . c1='DIFFERENTIAL GEAR',
277 . c2='DIFFERENTIAL GEAR',
278 . c3=titr)
279 ENDIF
280 iadll(nc+1) = iadll(nc) + 10
281 IF(iadll(nc+1)-1>lag_nkf)THEN
282 CALL ancmsg(msgid=469,
283 . msgtype=msgerror,
284 . anmode=aninfo,
285 . i1=id,
286 . c1='DIFFERENTIAL GEAR',
287 . c2='DIFFERENTIAL GEAR',
288 . c3=titr)
289 ENDIF
290 iad = iadll(nc) -1
291 DO jj=1,3
292 ik = iad+jj
293 lll(ik) = inod(jj)
294 jll(ik) = 1
295 ENDDO
296 iad = iad + 3
297 DO jj=1,3
298 ik = iad+jj
299 lll(ik) = inod(jj)
300 jll(ik) = 2
301 ENDDO
302 iad = iad + 3
303 DO jj=1,3
304 ik = iad+jj
305 lll(ik) = inod(jj)
306 jll(ik) = 3
307 ENDDO
308 ik = iad + 4
309 lll(ik) = inod(4)
310 jll(ik) = 6
311C
312C Local Constraints
313C --- local X
314 inod(4) = n0
315 nc = nc + 1
316 IF(nc>lag_ncf)THEN
317 CALL ancmsg(msgid=468,
318 . msgtype=msgerror,
319 . anmode=aninfo,
320 . i1=id,
321 . c1='DIFFERENTIAL GEAR',
322 . c2='DIFFERENTIAL GEAR',
323 . c3=titr)
324 ENDIF
325 iadll(nc+1)=iadll(nc) + 12
326 IF(iadll(nc+1)-1>lag_nkf)THEN
327 CALL ancmsg(msgid=469,
328 . msgtype=msgerror,
329 . anmode=aninfo,
330 . i1=id,
331 . c1='DIFFERENTIAL GEAR',
332 . c2='DIFFERENTIAL GEAR',
333 . c3=titr)
334 ENDIF
335 ik = iadll(nc)
336 lll(ik) = n1
337 jll(ik) = 4
338 ik = ik+1
339 lll(ik) = n1
340 jll(ik) = 5
341 ik = ik+1
342 lll(ik) = n1
343 jll(ik) = 6
344 DO i=2,3
345 ik = ik+1
346 lll(ik) = inod(i)
347 jll(ik) = 4
348 ik = ik+1
349 lll(ik) = inod(i)
350 jll(ik) = 5
351 ik = ik+1
352 lll(ik) = inod(i)
353 jll(ik) = 6
354 ENDDO
355 ik = ik+1
356 lll(ik) = n0
357 jll(ik) = 4
358 ik = ik+1
359 lll(ik) = n0
360 jll(ik) = 5
361 ik = ik+1
362 lll(ik) = n0
363 jll(ik) = 6
364C
365C local Y
366 DO i=1,3
367 nc = nc + 1
368 IF(nc>lag_ncf)THEN
369 CALL ancmsg(msgid=468,
370 . msgtype=msgerror,
371 . anmode=aninfo,
372 . i1=id,
373 . c1='DIFFERENTIAL GEAR',
374 . c2='DIFFERENTIAL GEAR',
375 . c3=titr)
376 ENDIF
377 iadll(nc+1)=iadll(nc) + 6
378 IF(iadll(nc+1)-1>lag_nkf)THEN
379 CALL ancmsg(msgid=469,
380 . msgtype=msgerror,
381 . anmode=aninfo,
382 . i1=id,
383 . c1='DIFFERENTIAL GEAR',
384 . c2='DIFFERENTIAL GEAR',
385 . c3=titr)
386 ENDIF
387 ik = iadll(nc)
388 lll(ik) = inod(i)
389 jll(ik) = 4
390 ik = ik+1
391 lll(ik) = inod(i)
392 jll(ik) = 5
393 ik = ik+1
394 lll(ik) = inod(i)
395 jll(ik) = 6
396 ik = ik+1
397 lll(ik) = n0
398 jll(ik) = 4
399 ik = ik+1
400 lll(ik) = n0
401 jll(ik) = 5
402 ik = ik+1
403 lll(ik) = n0
404 jll(ik) = 6
405 ENDDO
406C
407C local Z
408 DO i=1,3
409 nc = nc + 1
410 IF(nc>lag_ncf)THEN
411 CALL ancmsg(msgid=468,
412 . msgtype=msgerror,
413 . anmode=aninfo,
414 . i1=id,
415 . c1='DIFFERENTIAL GEAR',
416 . c2='DIFFERENTIAL GEAR',
417 . c3=titr)
418 ENDIF
419 iadll(nc+1)=iadll(nc) + 6
420 IF(iadll(nc+1)-1>lag_nkf)THEN
421 CALL ancmsg(msgid=469,
422 . msgtype=msgerror,
423 . anmode=aninfo,
424 . i1=id,
425 . c1='DIFFERENTIAL GEAR',
426 . c2='DIFFERENTIAL GEAR',
427 . c3=titr)
428 ENDIF
429 ik = iadll(nc)
430 lll(ik) = inod(i)
431 jll(ik) = 4
432 ik = ik+1
433 lll(ik) = inod(i)
434 jll(ik) = 5
435 ik = ik+1
436 lll(ik) = inod(i)
437 jll(ik) = 6
438 ik = ik+1
439 lll(ik) = n0
440 jll(ik) = 4
441 ik = ik+1
442 lll(ik) = n0
443 jll(ik) = 5
444 ik = ik+1
445 lll(ik) = n0
446 jll(ik) = 6
447 ENDDO
448C---
449 RETURN
450 END
ini_diff
subroutine ini_diff(iadll, jll, lll, n0, n1, n2, n3, nc, id, titr)
Definition ini_diff.F:34
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
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