OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lag_mult_h.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!|| lag_mult_h ../engine/source/tools/lagmul/lag_mult_h.F
25!||--- called by ------------------------------------------------------
26!|| lag_mult_solv ../engine/source/tools/lagmul/lag_mult_solv.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../engine/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE lag_mult_h(
34 1 NC ,LENH ,LHMAX ,MS ,IN ,
35 2 DIAG ,HH ,IADLL ,LLL ,JLL ,
36 3 XLL ,LTSM ,IADHF ,JCIHF ,IADH ,
37 4 JCIH ,RBYL ,NPBYL ,ICFTAG ,JCFTAG ,
38 5 NCF_S ,NCF_E ,NCR )
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "param_c.inc"
51#include "lagmult.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER NC,NCR,NCF_S,NCF_E,LENH,LHMAX
56 INTEGER LLL(*),JLL(*),IADLL(*),IADHF(*),JCIHF(*),IADH(*),JCIH(*),
57 . NPBYL(NNPBY,*),ICFTAG(*),JCFTAG(*)
58 my_real
59 . MS(*),IN(*),HH(*),DIAG(*),XLL(*),LTSM(6,*),RBYL(NRBY,*)
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I,J,K,IK,IC,ICF,JCF,IR,IFX,NFIX,NFRE,JC,JF,IH,IHF
64 my_real
65 . HIJ,DD
66C=======================================================================
67C stockage creux : diagonale + trangle inf en colonnes:
68C DIAG(NC)
69C IADH(NC+1)
70C JCIH(LENH)
71C=======================================================================
72 ih = 1
73 iadh(1) = 1
74C---
75C partie variable - Interfaces/Rwall
76C---
77 DO ic=1,ncf_s
78 DO ik=iadll(ic),iadll(ic+1)-1
79 i = lll(ik)
80 j = jll(ik)
81 IF (j>3) THEN
82 ltsm(j,i) = xll(ik)/in(i)
83 ELSE
84 ltsm(j,i) = xll(ik)/ms(i)
85 ENDIF
86 ENDDO
87 DO jc=ic+1,nc
88 hij = zero
89 DO ik=iadll(jc),iadll(jc+1)-1
90 hij = hij + xll(ik)*ltsm(jll(ik),lll(ik))
91 ENDDO
92 IF(hij/=zero)THEN
93 IF(ih>lhmax)THEN
94 CALL ancmsg(msgid=114,anmode=aninfo,
95 . i1=lhmax)
96 CALL arret(2)
97 ENDIF
98 hh(ih) = hij
99 jcih(ih) = jc
100 ih = ih + 1
101 ENDIF
102 ENDDO
103C---
104 iadh(ic+1) = ih
105 dd = zero
106 DO ik=iadll(ic),iadll(ic+1)-1
107 dd = dd + xll(ik)*ltsm(jll(ik),lll(ik))
108 ENDDO
109 IF(dd<=zero) THEN
110 CALL ancmsg(msgid=115,anmode=aninfo,
111 . i1=ic)
112 ENDIF
113 diag(ic) = dd
114 DO ik=iadll(ic),iadll(ic+1)-1
115 ltsm(jll(ik),lll(ik)) = zero
116 ENDDO
117 ENDDO
118C----
119C---- partie Fixe
120C----
121 DO ic=ncf_s+1,ncf_e
122 DO ik=iadll(ic),iadll(ic+1)-1
123 i = lll(ik)
124 j = jll(ik)
125 IF (j>3) THEN
126 ltsm(j,i) = xll(ik)/in(i)
127 ELSE
128 ltsm(j,i) = xll(ik)/ms(i)
129 ENDIF
130 ENDDO
131C Fixe/Fixe
132 icf = icftag(ic-ncf_s)
133 DO ihf=iadhf(icf),iadhf(icf+1)-1
134 jcf = jcihf(ihf)
135 jc = jcftag(jcf)
136 hij = zero
137 DO ik=iadll(jc),iadll(jc+1)-1
138 hij = hij + xll(ik)*ltsm(jll(ik),lll(ik))
139 ENDDO
140 IF(hij/=zero)THEN
141 hh(ih) = hij
142 jcih(ih) = jc
143 ih = ih + 1
144 ENDIF
145 ENDDO
146C Fixe/Variable
147 DO jc=ncf_e+1,nc
148 hij = zero
149 DO ik=iadll(jc),iadll(jc+1)-1
150 hij = hij + xll(ik)*ltsm(jll(ik),lll(ik))
151 ENDDO
152 IF(hij/=zero)THEN
153 IF(ih>lhmax)THEN
154 CALL ancmsg(msgid=114,anmode=aninfo,
155 . i1=lhmax)
156 CALL arret(2)
157 ENDIF
158 hh(ih) = hij
159 jcih(ih) = jc
160 ih = ih + 1
161 ENDIF
162 ENDDO
163C---
164 iadh(ic+1) = ih
165 dd = zero
166 DO ik=iadll(ic),iadll(ic+1)-1
167 dd = dd + xll(ik)*ltsm(jll(ik),lll(ik))
168 ENDDO
169 IF(dd<=zero) THEN
170 CALL ancmsg(msgid=115,anmode=aninfo,
171 . i1=ic)
172 ENDIF
173 diag(ic) = dd
174 DO ik=iadll(ic),iadll(ic+1)-1
175 ltsm(jll(ik),lll(ik)) = zero
176 ENDDO
177 ENDDO
178C----
179C partie Variable - RB
180C----
181 DO ic=ncf_e+1,ncr
182 DO ik=iadll(ic),iadll(ic+1)-1
183 i = lll(ik)
184 j = jll(ik)
185 IF (j>3) THEN
186 ltsm(j,i) = xll(ik)/in(i)
187 ELSE
188 ltsm(j,i) = xll(ik)/ms(i)
189 ENDIF
190 ENDDO
191 DO jc=ic+1,nc
192 hij = zero
193 DO ik=iadll(jc),iadll(jc+1)-1
194 hij = hij + xll(ik)*ltsm(jll(ik),lll(ik))
195 ENDDO
196 IF(hij/=zero)THEN
197 IF(ih>lhmax)THEN
198 CALL ancmsg(msgid=114,anmode=aninfo,
199 . i1=lhmax)
200 CALL arret(2)
201 ENDIF
202 hh(ih) = hij
203 jcih(ih) = jc
204 ih = ih + 1
205 ENDIF
206 ENDDO
207 iadh(ic+1) = ih
208 dd = 0.
209 DO ik=iadll(ic),iadll(ic+1)-1
210 dd = dd + xll(ik)*ltsm(jll(ik),lll(ik))
211 ENDDO
212 IF(dd<=zero) THEN
213 CALL ancmsg(msgid=115,anmode=aninfo,
214 . i1=ic)
215 ENDIF
216 diag(ic) = dd
217 DO ik=iadll(ic),iadll(ic+1)-1
218 ltsm(jll(ik),lll(ik)) = zero
219 ENDDO
220 ENDDO
221C----
222C partie RB condensee
223C----
224 ic = ncr
225 DO ir = 1,nrbylag
226 nfix = npbyl(4,ir)
227 nfre = npbyl(5,ir)
228 ifx = npbyl(7,ir)
229 IF (nfix>0.AND.nfre>0) THEN
230 DO k = 1,3
231 ic = ic + 1
232 DO ik=iadll(ic),iadll(ic+1)-1
233 i = lll(ik)
234 j = jll(ik)
235 IF (j<=3) THEN
236 ltsm(j,i) = xll(ik)/ms(i)
237 CALL ancmsg(msgid=116,anmode=aninfo,
238 . i1=i,i2=ic)
239 CALL arret(2)
240 ELSEIF (i/=ifx) THEN
241 ltsm(j,i) = xll(ik)/in(i)
242 ELSEIF (xll(ik)/=zero) THEN
243 IF(j==4) THEN
244 ltsm(4,i) = xll(ik)*rbyl(1,ir)
245 ltsm(5,i) = xll(ik)*rbyl(6,ir)
246 ltsm(6,i) = xll(ik)*rbyl(5,ir)
247 ELSEIF(j==5) THEN
248 ltsm(4,i) = xll(ik)*rbyl(6,ir)
249 ltsm(5,i) = xll(ik)*rbyl(2,ir)
250 ltsm(6,i) = xll(ik)*rbyl(4,ir)
251 ELSEIF(j==6) THEN
252 ltsm(4,i) = xll(ik)*rbyl(5,ir)
253 ltsm(5,i) = xll(ik)*rbyl(4,ir)
254 ltsm(6,i) = xll(ik)*rbyl(3,ir)
255 ENDIF
256 ENDIF
257 ENDDO
258 DO jc=ic+1,nc
259 hij = zero
260 DO ik=iadll(jc),iadll(jc+1)-1
261 hij = hij + xll(ik)*ltsm(jll(ik),lll(ik))
262 ENDDO
263 IF(hij/=zero)THEN
264 IF(ih>lhmax)THEN
265 CALL ancmsg(msgid=114,anmode=aninfo,
266 . i1=lhmax)
267 CALL arret(2)
268 ENDIF
269 hh(ih) = hij
270 jcih(ih) = jc
271 ih = ih + 1
272 ENDIF
273 ENDDO
274 iadh(ic+1) = ih
275 dd = zero
276 DO ik=iadll(ic),iadll(ic+1)-1
277 dd = dd + xll(ik)*ltsm(jll(ik),lll(ik))
278 ENDDO
279 IF(dd<=zero) THEN
280 CALL ancmsg(msgid=115,anmode=aninfo,
281 . i1=ic)
282 ENDIF
283 diag(ic) = dd
284 DO ik=iadll(ic),iadll(ic+1)-1
285 i = lll(ik)
286 j = jll(ik)
287 IF (j<=3) THEN
288 ltsm(j,i) = zero
289 ELSE
290 ltsm(4,i) = zero
291 ltsm(5,i) = zero
292 ltsm(6,i) = zero
293 ENDIF
294 ENDDO
295 ENDDO
296 ENDIF
297 ENDDO
298 lenh = ih - 1
299C--------------------------------------------
300 RETURN
301 END
302C
303!||====================================================================
304!|| lag_mult_hp ../engine/source/tools/lagmul/lag_mult_h.F
305!||--- called by ------------------------------------------------------
306!|| lag_mult_sdp ../engine/source/tools/lagmul/lag_mult_solv.F
307!|| lag_mult_solvp ../engine/source/tools/lagmul/lag_mult_solv.F
308!||--- calls -----------------------------------------------------
309!|| ancmsg ../engine/source/output/message/message.F
310!|| arret ../engine/source/system/arret.F
311!||--- uses -----------------------------------------------------
312!|| message_mod ../engine/share/message_module/message_mod.F
313!||====================================================================
314 SUBROUTINE lag_mult_hp(
315 1 NC ,LENH ,LHMAX ,MS ,IN ,
316 2 DIAG ,HH ,IADLL ,LLL ,JLL ,
317 3 XLL ,LTSM ,IADHF ,JCIHF ,IADH ,
318 4 JCIH ,RBYL ,NPBYL ,ICFTAG ,JCFTAG ,
319 5 NCF_S ,NCF_E ,NCR ,INDEXLAG)
320C-----------------------------------------------
321C M o d u l e s
322C-----------------------------------------------
323 USE message_mod
324C-----------------------------------------------
325C I m p l i c i t T y p e s
326C-----------------------------------------------
327#include "implicit_f.inc"
328C-----------------------------------------------
329C G l o b a l P a r a m e t e r s
330C-----------------------------------------------
331#include "param_c.inc"
332#include "lagmult.inc"
333C-----------------------------------------------
334C D u m m y A r g u m e n t s
335C-----------------------------------------------
336 INTEGER NC,NCR,NCF_S,NCF_E,LENH,LHMAX
337 INTEGER LLL(*),JLL(*),IADLL(*),IADHF(*),JCIHF(*),IADH(*),JCIH(*),
338 . NPBYL(NNPBY,*),ICFTAG(*),JCFTAG(*),INDEXLAG(*)
339 my_real
340 . MS(*),IN(*),HH(*),DIAG(*),XLL(*),LTSM(6,*),RBYL(NRBY,*)
341C-----------------------------------------------
342C L o c a l V a r i a b l e s
343C-----------------------------------------------
344 INTEGER I,J,K,IK,IC,ICF,JCF,IR,IFX,NFIX,NFRE,JC,JF,IH,IHF,II
345 my_real
346 . hij,dd
347C=======================================================================
348C stockage creux : diagonale + trangle inf en colonnes:
349C DIAG(NC)
350C IADH(NC+1)
351C JCIH(LENH)
352C=======================================================================
353 ih = 1
354 iadh(1) = 1
355C---
356C partie variable - Interfaces/Rwall
357C---
358 DO ic=1,ncf_s
359 DO ik=iadll(ic),iadll(ic+1)-1
360 i = lll(ik)
361 ii = indexlag(i)
362 j = jll(ik)
363 IF (j>3) THEN
364 ltsm(j,i) = xll(ik)/in(ii)
365 ELSE
366 ltsm(j,i) = xll(ik)/ms(ii)
367 ENDIF
368 ENDDO
369 DO jc=ic+1,nc
370 hij = zero
371 DO ik=iadll(jc),iadll(jc+1)-1
372 hij = hij + xll(ik)*ltsm(jll(ik),lll(ik))
373 ENDDO
374 IF(hij/=zero)THEN
375 IF(ih>lhmax)THEN
376 CALL ancmsg(msgid=114,anmode=aninfo,
377 . i1=lhmax)
378 CALL arret(2)
379 ENDIF
380 hh(ih) = hij
381 jcih(ih) = jc
382 ih = ih + 1
383 ENDIF
384 ENDDO
385C---
386 iadh(ic+1) = ih
387 dd = zero
388 DO ik=iadll(ic),iadll(ic+1)-1
389 dd = dd + xll(ik)*ltsm(jll(ik),lll(ik))
390 ENDDO
391 IF(dd<=zero) THEN
392 CALL ancmsg(msgid=115,anmode=aninfo,
393 . i1=ic)
394 ENDIF
395 diag(ic) = dd
396 DO ik=iadll(ic),iadll(ic+1)-1
397 ltsm(jll(ik),lll(ik)) = zero
398 ENDDO
399 ENDDO
400C----
401C---- partie Fixe
402C----
403 DO ic=ncf_s+1,ncf_e
404 DO ik=iadll(ic),iadll(ic+1)-1
405 i = lll(ik)
406 ii = indexlag(i)
407 j = jll(ik)
408 IF (j>3) THEN
409 ltsm(j,i) = xll(ik)/in(ii)
410 ELSE
411 ltsm(j,i) = xll(ik)/ms(ii)
412 ENDIF
413 ENDDO
414C Fixe/Fixe
415 icf = icftag(ic-ncf_s)
416 DO ihf=iadhf(icf),iadhf(icf+1)-1
417 jcf = jcihf(ihf)
418 jc = jcftag(jcf)
419 hij = zero
420 DO ik=iadll(jc),iadll(jc+1)-1
421 hij = hij + xll(ik)*ltsm(jll(ik),lll(ik))
422 ENDDO
423 IF(hij/=zero)THEN
424 hh(ih) = hij
425 jcih(ih) = jc
426 ih = ih + 1
427 ENDIF
428 ENDDO
429C Fixe/Variable
430 DO jc=ncf_e+1,nc
431 hij = zero
432 DO ik=iadll(jc),iadll(jc+1)-1
433 hij = hij + xll(ik)*ltsm(jll(ik),lll(ik))
434 ENDDO
435 IF(hij/=zero)THEN
436 IF(ih>lhmax)THEN
437 CALL ancmsg(msgid=114,anmode=aninfo,
438 . i1=lhmax)
439 CALL arret(2)
440 ENDIF
441 hh(ih) = hij
442 jcih(ih) = jc
443 ih = ih + 1
444 ENDIF
445 ENDDO
446C---
447 iadh(ic+1) = ih
448 dd = zero
449 DO ik=iadll(ic),iadll(ic+1)-1
450 dd = dd + xll(ik)*ltsm(jll(ik),lll(ik))
451 ENDDO
452 IF(dd<=zero) THEN
453 CALL ancmsg(msgid=115,anmode=aninfo,
454 . i1=ic)
455 ENDIF
456 diag(ic) = dd
457 DO ik=iadll(ic),iadll(ic+1)-1
458 ltsm(jll(ik),lll(ik)) = zero
459 ENDDO
460 ENDDO
461C----
462C partie Variable - RB
463C----
464 DO ic=ncf_e+1,ncr
465 DO ik=iadll(ic),iadll(ic+1)-1
466 i = lll(ik)
467 ii = indexlag(i)
468 j = jll(ik)
469 IF (j>3) THEN
470 ltsm(j,i) = xll(ik)/in(ii)
471 ELSE
472 ltsm(j,i) = xll(ik)/ms(ii)
473 ENDIF
474 ENDDO
475 DO jc=ic+1,nc
476 hij = zero
477 DO ik=iadll(jc),iadll(jc+1)-1
478 hij = hij + xll(ik)*ltsm(jll(ik),lll(ik))
479 ENDDO
480 IF(hij/=zero)THEN
481 IF(ih>lhmax)THEN
482 CALL ancmsg(msgid=114,anmode=aninfo,
483 . i1=lhmax)
484 CALL arret(2)
485 ENDIF
486 hh(ih) = hij
487 jcih(ih) = jc
488 ih = ih + 1
489 ENDIF
490 ENDDO
491 iadh(ic+1) = ih
492 dd = 0.
493 DO ik=iadll(ic),iadll(ic+1)-1
494 dd = dd + xll(ik)*ltsm(jll(ik),lll(ik))
495 ENDDO
496 IF(dd<=zero) THEN
497 CALL ancmsg(msgid=115,anmode=aninfo,
498 . i1=ic)
499 ENDIF
500 diag(ic) = dd
501 DO ik=iadll(ic),iadll(ic+1)-1
502 ltsm(jll(ik),lll(ik)) = zero
503 ENDDO
504 ENDDO
505C----
506C partie RB condensee
507C----
508 ic = ncr
509 DO ir = 1,nrbylag
510 nfix = npbyl(4,ir)
511 nfre = npbyl(5,ir)
512 ifx = npbyl(7,ir)
513 IF (nfix>0.AND.nfre>0) THEN
514 DO k = 1,3
515 ic = ic + 1
516 DO ik=iadll(ic),iadll(ic+1)-1
517 i = lll(ik)
518 ii = indexlag(i)
519 j = jll(ik)
520 IF (j<=3) THEN
521 ltsm(j,i) = xll(ik)/ms(ii)
522 CALL ancmsg(msgid=116,anmode=aninfo,
523 . i1=i,i2=ic)
524 CALL arret(2)
525 ELSEIF (i/=ifx) THEN
526 ltsm(j,i) = xll(ik)/in(ii)
527 ELSEIF (xll(ik)/=zero) THEN
528 IF(j==4) THEN
529 ltsm(4,i) = xll(ik)*rbyl(1,ir)
530 ltsm(5,i) = xll(ik)*rbyl(6,ir)
531 ltsm(6,i) = xll(ik)*rbyl(5,ir)
532 ELSEIF(j==5) THEN
533 ltsm(4,i) = xll(ik)*rbyl(6,ir)
534 ltsm(5,i) = xll(ik)*rbyl(2,ir)
535 ltsm(6,i) = xll(ik)*rbyl(4,ir)
536 ELSEIF(j==6) THEN
537 ltsm(4,i) = xll(ik)*rbyl(5,ir)
538 ltsm(5,i) = xll(ik)*rbyl(4,ir)
539 ltsm(6,i) = xll(ik)*rbyl(3,ir)
540 ENDIF
541 ENDIF
542 ENDDO
543 DO jc=ic+1,nc
544 hij = zero
545 DO ik=iadll(jc),iadll(jc+1)-1
546 hij = hij + xll(ik)*ltsm(jll(ik),lll(ik))
547 ENDDO
548 IF(hij/=zero)THEN
549 IF(ih>lhmax)THEN
550 CALL ancmsg(msgid=114,anmode=aninfo,
551 . i1=lhmax)
552 CALL arret(2)
553 ENDIF
554 hh(ih) = hij
555 jcih(ih) = jc
556 ih = ih + 1
557 ENDIF
558 ENDDO
559 iadh(ic+1) = ih
560 dd = zero
561 DO ik=iadll(ic),iadll(ic+1)-1
562 dd = dd + xll(ik)*ltsm(jll(ik),lll(ik))
563 ENDDO
564 IF(dd<=zero) THEN
565 CALL ancmsg(msgid=115,anmode=aninfo,
566 . i1=ic)
567 ENDIF
568 diag(ic) = dd
569 DO ik=iadll(ic),iadll(ic+1)-1
570 i = lll(ik)
571 j = jll(ik)
572 IF (j<=3) THEN
573 ltsm(j,i) = zero
574 ELSE
575 ltsm(4,i) = zero
576 ltsm(5,i) = zero
577 ltsm(6,i) = zero
578 ENDIF
579 ENDDO
580 ENDDO
581 ENDIF
582 ENDDO
583 lenh = ih - 1
584C--------------------------------------------
585 RETURN
586 END
lag_mult_hp
subroutine lag_mult_hp(nc, lenh, lhmax, ms, in, diag, hh, iadll, lll, jll, xll, ltsm, iadhf, jcihf, iadh, jcih, rbyl, npbyl, icftag, jcftag, ncf_s, ncf_e, ncr, indexlag)
Definition lag_mult_h.F:320
lag_mult_h
subroutine lag_mult_h(nc, lenh, lhmax, ms, in, diag, hh, iadll, lll, jll, xll, ltsm, iadhf, jcihf, iadh, jcih, rbyl, npbyl, icftag, jcftag, ncf_s, ncf_e, ncr)
Definition lag_mult_h.F:39
message_mod
Definition message_mod.F:1249
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
arret
subroutine arret(nn)
Definition arret.F:87