OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lec_inistate_tri.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!|| lec_inistate_tri ../starter/source/elements/initia/lec_inistate_tri.f
25!||--- called by ------------------------------------------------------
26!|| lec_inistate ../starter/source/elements/initia/lec_inistate.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| uel2sys ../starter/source/initial_conditions/inista/yctrl.F
30!||--- uses -----------------------------------------------------
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE lec_inistate_tri(
34 1 IXS ,IXQ ,IXC ,IXT ,IXP ,
35 2 IXR ,KXSP ,IXTG ,INDEX ,ITRI ,
36 3 NSIGSH ,NSIGS ,NSIGSPH ,KSYSUSR ,KSIGSH3 ,
37 4 NSIGRS ,NSIGI ,NSIGBEAM ,NSIGTRUSS ,
38 5 PTSHEL ,PTSH3N ,PTSOL ,PTQUAD ,PTSPH ,
39 6 PTSPRI ,PTBEAM ,PTTRUSS ,SIGI ,SIGSH ,
40 7 SIGSP ,SIGSPH ,SIGRS ,SIGBEAM ,SIGTRUSS ,
41 8 ID_SIGSH ,ID_SOLID_SIGI,ID_QUAD_SIGI ,ID_SIGSPRI ,ID_SIGBEAM ,
42 9 ID_SIGTRUSS,WORK ,ID_SIGSPHCEL ,IS_STATE)
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE message_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com01_c.inc"
55#include "com04_c.inc"
56#include "scry_c.inc"
57#include "sphcom.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),IXTG(NIXTG,*)
62 INTEGER INDEX(*),ITRI(*),KXSP(*),KSYSUSR(*)
63 INTEGER PTSHEL(*),PTSH3N(*),PTSOL(*),PTQUAD(*),PTSPH(*),PTSPRI(*),PTBEAM(*),PTTRUSS(*)
64 INTEGER NSIGI,NSIGSH,NSIGS, NSIGSPH, NSIGRS, NSIGBEAM, NSIGTRUSS, KSIGSH3
65 INTEGER ID_SIGSH(*), ID_SOLID_SIGI(*), ID_QUAD_SIGI(*)
66 INTEGER ID_SIGSPRI(*), ID_SIGBEAM(*), ID_SIGTRUSS(*)
67 INTEGER WORK(*)
68 my_real
69 . SIGI(NSIGS,*),SIGSH(MAX(1,NSIGSH),*),SIGTRUSS(NSIGTRUSS,*),
70 . sigsp(nsigi,*),sigsph(nsigsph,*),sigrs(nsigrs,*),sigbeam(nsigbeam,*)
71
72 INTEGER, INTENT(INOUT) :: ID_SIGSPHCEL(NUMSPH)
73 LOGICAL, INTENT(IN) :: IS_STATE
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I, J, K
78 INTEGER ISYS,JSYS,II,IE,JE,COMPT,NUMSHEL0
79C-----------------------------------------------
80 EXTERNAL UEL2SYS
81 INTEGER UEL2SYS
82C----------------------------------------------------------------------
83 IF (abs(isigi) == 3.OR.abs(isigi) == 4.OR.abs(isigi) == 5) THEN
84C
85C SHELL 4-NODES
86C
87 numshel0 = numshel
88 IF(numshel>0)THEN
89C tri des elts du Y000 par ID croissant
90
91 DO isys = 1, numshel
92 itri(isys) =id_sigsh(isys)
93 END DO
94 CALL my_orders(0,work,itri,index,numshel,1)
95C checking INISHE : search for multiply define
96 isys = index(1)
97 ie = id_sigsh(isys)
98 DO j = 2, numshel
99 jsys=index(j)
100 je =id_sigsh(jsys)
101 IF(je == ie)THEN
102 DO k=2,nsigsh
103 IF(sigsh(k,jsys)/=zero)THEN
104 IF(sigsh(k,isys)/=zero.AND.
105 . sigsh(k,isys)/=sigsh(k,jsys))THEN
106 CALL ancmsg(msgid=595,
107 . msgtype=msgerror,
108 . anmode=aninfo_blind_1,
109 . i1=ie)
110 ELSE
111 sigsh(k,isys)=sigsh(k,jsys)
112 END IF
113 END IF
114 END DO
115 sigsh(1,jsys)=zero
116 id_sigsh(jsys)=0
117 ELSE
118 ie =je
119 isys=jsys
120 END IF
121 END DO
122 compt=0
123 DO j=1,numshel
124 ie=id_sigsh(j)
125 IF(ie/=0)THEN
126 compt=compt+1
127 IF(compt<j)THEN
128 DO k=1,nsigsh
129 sigsh(k,compt)=sigsh(k,j)
130 END DO
131 id_sigsh(compt)=id_sigsh(j)
132
133 sigsh(1,j)=zero
134 id_sigsh(j)=0
135 END IF
136 END IF
137 END DO
138 numshel=compt
139 ENDIF
140C
141 IF(numshel>0)THEN
142C tri des elts du Y000 par ID croissant
143
144 DO isys = 1,numshel
145 itri(isys) = id_sigsh(isys)
146 END DO
147 CALL my_orders(0,work,itri,index,numshel,1)
148 DO j = 1, numshel
149 isys=index(j)
150 ksysusr(j)=id_sigsh(isys)
151 ksysusr(numshel+j)=isys
152 END DO
153C
154C Nos systeme dans le Y000, des elts du D00
155 DO i=1,numelc
156 isys=uel2sys(ixc(nixc,i),ksysusr,numshel)
157 ptshel(i) =isys
158 END DO
159 ENDIF
160C
161C SHELL 3-NODES
162C
163 IF(numsh3n>0)THEN
164C tri des elts du Y000 par ID croissant
165 DO isys = 1, numsh3n
166 ii= numshel0 + isys
167 itri(isys) = id_sigsh(ii)
168 END DO
169 CALL my_orders(0,work,itri,index,numsh3n,1)
170C
171 isys = numshel0 + index(1)
172 ie = id_sigsh(isys)
173 DO j = 2, numsh3n
174 jsys=numshel0+index(j)
175 je =id_sigsh(jsys)
176 IF(je == ie)THEN
177 DO k=2,nsigsh
178 IF(sigsh(k,jsys)/=zero)THEN
179 IF(sigsh(k,isys)/=zero.AND.
180 . sigsh(k,isys)/=sigsh(k,jsys))THEN
181 CALL ancmsg(msgid=596,
182 . msgtype=msgerror,
183 . anmode=aninfo_blind_1,
184 . i1=ie)
185 ELSE
186 sigsh(k,isys)=sigsh(k,jsys)
187 END IF
188 END IF
189 END DO
190 sigsh(1,jsys)=zero
191 id_sigsh(jsys)=0
192 ELSE
193 ie =je
194 isys=jsys
195 END IF
196 END DO
197 compt=0
198 DO j=1,numsh3n
199 ie=id_sigsh(numshel0 + j)
200 IF(ie /=0 )THEN
201 compt=compt+1
202 IF(numshel+compt<numshel0+j)THEN
203 DO k=1,nsigsh
204 sigsh(k,numshel+compt)=sigsh(k,numshel0+j)
205 END DO
206 id_sigsh(numshel+compt)=id_sigsh(numshel0+j)
207
208 sigsh(1,numshel0+j)=zero
209 id_sigsh(numshel0+j)=0
210 END IF
211 END IF
212 END DO
213 numsh3n=compt
214 END IF
215C
216 IF (numsh3n > 0) THEN
217C tri des elts du Y000 par ID croissant
218 DO isys = 1, numsh3n
219 ii = isys + numshel0
220 itri(isys) = id_sigsh(ii)
221 END DO
222 CALL my_orders(0,work,itri,index,numsh3n,1)
223C
224 DO j = 1, numsh3n
225 isys = index(j)
226 ii = isys + numshel0
227 ksysusr(j) = id_sigsh(ii)
228 ksysusr(numsh3n + j) = isys
229 END DO
230C
231C Nos systeme dans le Y000, des elts du D00
232 DO i=1,numeltg
233 isys = uel2sys(ixtg(nixtg,i),ksysusr,numsh3n)
234 ptsh3n(i) = isys
235 END DO
236 ENDIF
237C
238C BRICK
239C
240 IF(numsol>0)THEN
241C
242C tri des elts de SIGI par ID croissant
243 DO isys = 1, numsol
244 itri(isys) = id_solid_sigi(isys)
245 END DO
246 CALL my_orders(0,work,itri,index,numsol,1)
247C
248C checking (search for multiply define) and compacting INISOL
249 isys=index(1)
250 ie =id_solid_sigi(isys)
251 DO j = 2, numsol
252 jsys=index(j)
253 je =id_solid_sigi(jsys)
254 IF(je == ie)THEN
255 DO k=1,6
256 IF((sigi(k,jsys)/=zero) .AND.
257 . (sigi(k,isys)/=sigi(k,jsys)) )THEN
258 IF(sigi(k,isys)/=zero)THEN
259 CALL ancmsg(msgid=597,
260 . msgtype=msgerror,
261 . anmode=aninfo_blind_1,
262 . i1=ie)
263 ELSE
264 sigi(k,isys)=sigi(k,jsys)
265 END IF
266 END IF
267 END DO
268 DO k=8,10
269 IF(sigi(k,jsys)/=zero .AND.
270 . (sigi(k,isys)/=sigi(k,jsys)) )THEN
271 IF(sigi(k,isys)/=zero)THEN
272 CALL ancmsg(msgid=597,
273 . msgtype=msgerror,
274 . anmode=aninfo_blind_1,
275 . i1=ie)
276 ELSE
277 sigi(k,isys)=sigi(k,jsys)
278 END IF
279 END IF
280 END DO
281 DO k=1,nsigi
282 IF(sigsp(k,jsys)/=zero .AND.
283 . (sigsp(k,isys)/=sigsp(k,jsys)) )THEN
284 IF(sigsp(k,isys)/=zero)THEN
285 CALL ancmsg(msgid=597,
286 . msgtype=msgerror,
287 . anmode=aninfo_blind_1,
288 . i1=ie)
289 ELSE
290 sigsp(k,isys)=sigsp(k,jsys)
291 END IF
292 END IF
293 END DO
294 id_solid_sigi(jsys)=0
295 ELSE
296 ie =je
297 isys=jsys
298 END IF
299 END DO
300 compt=0
301 DO j=1,numsol
302 ie=id_solid_sigi(j)
303 IF(ie/=0)THEN
304 compt=compt+1
305 IF(compt<j)THEN
306 DO k=1,6
307 sigi(k,compt)=sigi(k,j)
308 END DO
309 id_solid_sigi(compt)=id_solid_sigi(j)
310 DO k=8,10
311 sigi(k,compt)=sigi(k,j)
312 END DO
313 DO k=1,nsigi
314 sigsp(k,compt)=sigsp(k,j)
315 END DO
316 id_solid_sigi(j)=0
317 END IF
318 END IF
319 END DO
320 numsol=compt
321 END IF
322C
323 IF(numsol>0)THEN
324C
325C tri des elts du Y000 par ID croissant
326 DO isys = 1, numsol
327 itri(isys) = id_solid_sigi(isys)
328 END DO
329 CALL my_orders(0,work,itri,index,numsol,1)
330 DO j = 1, numsol
331 isys=index(j)
332 ksysusr(j)=id_solid_sigi(isys)
333 ksysusr(numsol+j)=isys
334 END DO
335C
336C Nos systeme dans le Y000, des elts du D00
337 DO i=1,numels
338 isys=uel2sys(ixs(nixs,i),ksysusr,numsol)
339 ptsol(i) =isys
340 END DO
341 END IF
342C
343C QUAD 2D
344C
345 IF(numquad>0)THEN
346C
347C tri des elts de SIGI par ID croissant
348 DO isys = 1, numquad
349 itri(isys) = id_quad_sigi(isys)
350 END DO
351 CALL my_orders(0,work,itri,index,numquad,1)
352C
353C checking (search for multiply define) and compacting INIQUA
354 isys=index(1)
355 ie =id_quad_sigi(isys)
356 DO j = 2, numquad
357 jsys=index(j)
358 je =id_quad_sigi(jsys)
359 IF(je == ie)THEN
360 DO k=1,6
361 IF(sigi(k,jsys)/=zero)THEN
362 IF(sigi(k,isys)/=zero)THEN
363 CALL ancmsg(msgid=598,
364 . msgtype=msgerror,
365 . anmode=aninfo_blind_1,
366 . i1=ie)
367 ELSE
368 sigi(k,isys)=sigi(k,jsys)
369 END IF
370 END IF
371 END DO
372 DO k=8,10
373 IF(sigi(k,jsys)/=zero)THEN
374 IF(sigi(k,isys)/=zero)THEN
375 CALL ancmsg(msgid=598,
376 . msgtype=msgerror,
377 . anmode=aninfo_blind_1,
378 . i1=ie)
379 ELSE
380 sigi(k,isys)=sigi(k,jsys)
381 END IF
382 END IF
383 END DO
384 id_quad_sigi(jsys) = 0
385 ELSE
386 ie =je
387 isys=jsys
388 END IF
389 END DO
390 compt=0
391 DO j=1,numquad
392 ie=id_quad_sigi(j)
393 IF(ie/=0)THEN
394 compt=compt+1
395 IF(compt<j)THEN
396 DO k=1,6
397 sigi(k,compt)=sigi(k,j)
398 END DO
399 id_quad_sigi(compt)= id_quad_sigi(j)
400 DO k=8,10
401 sigi(k,compt)=sigi(k,j)
402 END DO
403 id_quad_sigi(j) = 0
404 END IF
405 END IF
406 END DO
407 numquad=compt
408 END IF
409C
410 IF(numquad>0)THEN
411C
412C tri des elts du Y000 par ID croissant
413 DO isys = 1, numquad
414 itri(isys) = id_quad_sigi(isys)
415 END DO
416 CALL my_orders(0,work,itri,index,numquad,1)
417 DO j = 1, numquad
418 isys=index(j)
419 ksysusr(j)=id_quad_sigi(isys)
420 ksysusr(numquad+j)=isys
421 END DO
422C
423C Nos systeme dans le Y000, des elts du D00
424 DO i=1,numelq
425 isys=uel2sys(ixq(nixq,i),ksysusr,numquad)
426 ptquad(i) =isys
427 END DO
428 END IF
429C
430 END IF ! IF (ABS(ISIGI) == 3.OR.ABS(ISIGI) == 4.OR.ABS(ISIGI) == 5)
431C
432C SPH
433C
434 IF(numsphy>0 .AND. is_state)THEN
435C sorting elements Ids
436 DO isys = 1, numsphy
437 itri(isys) = id_sigsphcel(isys)
438 END DO
439 CALL my_orders(0,work,itri,index,numsphy,1)
440C checking INISPHCEL : search for multiply define
441 isys=index(1)
442 ie = id_sigsphcel(isys)
443
444 DO j = 2, numsphy
445 jsys=index(j)
446 je = id_sigsphcel(jsys)
447 IF (je == ie) THEN
448 DO k=1,nsigsph
449 IF (sigsph(k,jsys) /= zero) THEN
450 IF (sigsph(k,isys) /= zero .AND.
451 . sigsph(k,isys) /= sigsph(k,jsys)) THEN
452 CALL ancmsg(msgid=1234,
453 . msgtype=msgerror,
454 . anmode=aninfo_blind_1,
455 . i1=ie)
456 ELSE
457 sigsph(k,isys)=sigsph(k,jsys)
458 ENDIF
459 ENDIF
460 ENDDO
461 sigsph(1,jsys)=zero
462 id_sigsphcel(jsys)=0
463 ELSE
464 ie =je
465 isys=jsys
466 ENDIF
467 ENDDO
468 compt=0
469 DO j=1,numsphy
470 ie = id_sigsphcel(j)
471 IF (ie /= 0) THEN
472 compt=compt+1
473 IF (compt < j) THEN
474 DO k=1,nsigsph
475 sigsph(k,compt)=sigsph(k,j)
476 ENDDO
477 id_sigsphcel(compt)=id_sigsphcel(j)
478 sigsph(1,j)=zero
479 id_sigsphcel(j)=0
480 ENDIF
481 ENDIF
482 ENDDO
483 numsphy=compt
484
485
486 ENDIF ! IF (NUMSPHY > 0)
487
488
489
490
491 IF (numsphy > 0) THEN
492C sorting elements Ids
493 DO isys = 1, numsphy
494 IF(is_state) THEN
495 itri(isys) = id_sigsphcel(isys)
496 ELSE
497 itri(isys) = nint(sigsph(7,isys))
498 ENDIF
499 END DO
500 CALL my_orders(0,work,itri,index,numsphy,1)
501 DO j = 1, numsphy
502 isys=index(j)
503 IF(is_state) THEN
504 ksysusr(j) = id_sigsphcel(isys)
505 ELSE
506 ksysusr(j) = nint(sigsph(7,isys))
507 ENDIF
508 ksysusr(numsphy+j)=isys
509 END DO
510C
511 DO i=1,numsph
512 isys=uel2sys(kxsp(nisp*i),ksysusr,numsphy)
513 ptsph(i) =isys
514 END DO
515 END IF
516C
517 IF (abs(isigi)<3) THEN
518 ksigsh3=1+numelc
519 ELSE
520 ksigsh3=1+numshel
521 END IF
522C
523C SPRING
524C
525 IF (numspri > 0) THEN
526C
527 inispri = 1
528C tri des elts du Y000 par ID croissant
529 DO isys = 1, numspri
530 itri(isys) =id_sigspri(isys)
531 ENDDO
532 CALL my_orders(0,work,itri,index,numspri,1)
533C checking INISPRI : search for multiply define
534 isys=index(1)
535 ie =id_sigspri(isys)
536 DO j = 2, numspri
537 jsys=index(j)
538 je =id_sigspri(jsys)
539 IF (je == ie) THEN
540 DO k=2,nsigrs
541 IF (sigrs(k,jsys) /= zero) THEN
542 IF (sigrs(k,isys) /= zero .AND.
543 . sigrs(k,isys) /= sigrs(k,jsys)) THEN
544 CALL ancmsg(msgid=1234,
545 . msgtype=msgerror,
546 . anmode=aninfo_blind_1,
547 . i1=ie)
548 ELSE
549 sigrs(k,isys)=sigrs(k,jsys)
550 ENDIF
551 ENDIF
552 ENDDO
553 sigrs(1,jsys)=zero
554 id_sigspri(jsys)=0
555 ELSE
556 ie =je
557 isys=jsys
558 ENDIF
559 ENDDO
560 compt=0
561 DO j=1,numspri
562 ie=id_sigspri(j)
563 IF (ie /= 0) THEN
564 compt=compt+1
565 IF (compt < j) THEN
566 DO k=1,nsigrs
567 sigrs(k,compt)=sigrs(k,j)
568 ENDDO
569 id_sigspri(compt)=id_sigspri(j)
570 sigrs(1,j)=zero
571 id_sigspri(j)=0
572 ENDIF
573 ENDIF
574 ENDDO
575 numspri=compt
576 ENDIF ! IF (NUMSPRI > 0)
577C
578 IF (numspri > 0) THEN
579C tri des elts du Y000 par ID croissant
580 DO isys = 1, numspri
581 itri(isys) = id_sigspri(isys)
582 ENDDO
583 CALL my_orders(0,work,itri,index,numspri,1)
584 DO j = 1, numspri
585 isys=index(j)
586 ksysusr(j)=id_sigspri(isys)
587 ksysusr(numspri+j)=isys
588 ENDDO
589C
590C Nos systeme dans le Y000, des elts du D00
591 DO i=1,numelr
592 isys=uel2sys(ixr(nixr,i),ksysusr,numspri)
593 ptspri(i) =isys
594 ENDDO
595 ENDIF ! IF (NUMSPRI > 0)
596C
597C BEAM
598C
599 IF (numbeam > 0) THEN
600C tri des elts du Y000 par ID croissant
601 DO isys = 1, numbeam
602 itri(isys) =id_sigbeam(isys)
603 ENDDO
604 CALL my_orders(0,work,itri,index,numbeam,1)
605C checking INIBEAM : search for multiply define
606 isys=index(1)
607 ie =id_sigbeam(isys)
608 DO j = 2, numbeam
609 jsys=index(j)
610 je =id_sigbeam(jsys)
611 IF (je == ie) THEN
612 DO k=2,nsigbeam
613 IF (sigbeam(k,jsys) /= zero) THEN
614 IF (sigbeam(k,isys) /= zero .AND.
615 . sigbeam(k,isys) /= sigbeam(k,jsys)) THEN
616 CALL ancmsg(msgid=1235,
617 . msgtype=msgerror,
618 . anmode=aninfo_blind_1,
619 . i1=ie)
620 ELSE
621 sigbeam(k,isys)=sigbeam(k,jsys)
622 ENDIF
623 ENDIF
624 ENDDO
625 sigbeam(1,jsys)=zero
626 id_sigbeam(jsys)=0
627 ELSE
628 ie =je
629 isys=jsys
630 ENDIF
631 ENDDO
632 compt=0
633 DO j=1,numbeam
634 ie=id_sigbeam(j)
635 IF (ie /= 0) THEN
636 compt=compt+1
637 IF (compt < j) THEN
638 DO k=1,nsigbeam
639 sigbeam(k,compt)=sigbeam(k,j)
640 ENDDO
641 id_sigbeam(compt)=id_sigbeam(j)
642 sigbeam(1,j)=zero
643 id_sigbeam(j)=0
644 ENDIF
645 ENDIF
646 ENDDO
647 numbeam=compt
648 ENDIF ! IF (NUMBEAM > 0)
649C
650 IF (numbeam > 0) THEN
651C tri des elts du Y000 par ID croissant
652 DO isys = 1, numbeam
653 itri(isys) = id_sigbeam(isys)
654 ENDDO
655 CALL my_orders(0,work,itri,index,numbeam,1)
656 DO j = 1, numbeam
657 isys=index(j)
658 ksysusr(j)=id_sigbeam(isys)
659 ksysusr(numbeam+j)=isys
660 ENDDO
661C
662C Nos systeme dans le Y000, des elts du D00
663 DO i=1,numelp
664 isys=uel2sys(ixp(nixp,i),ksysusr,numbeam)
665 ptbeam(i) =isys
666 ENDDO
667 ENDIF ! IF (NUMBEAM > 0)
668C
669C TRUSS
670C
671 IF (numtrus > 0) THEN
672C tri des elts du Y000 par ID croissant
673 DO isys = 1, numtrus
674 itri(isys) =id_sigtruss(isys)
675 ENDDO
676 CALL my_orders(0,work,itri,index,numtrus,1)
677C checking INITRUSS : search for multiply define
678 isys=index(1)
679 ie =id_sigtruss(isys)
680 DO j = 2, numtrus
681 jsys=index(j)
682 je =id_sigtruss(jsys)
683 IF (je == ie) THEN
684 DO k=2,nsigtruss
685 IF (sigtruss(k,jsys) /= zero) THEN
686 IF (sigtruss(k,isys) /= zero .AND.
687 . sigtruss(k,isys) /= sigtruss(k,jsys)) THEN
688 CALL ancmsg(msgid=1239,
689 . msgtype=msgerror,
690 . anmode=aninfo_blind_1,
691 . i1=ie)
692 ELSE
693 sigtruss(k,isys)=sigtruss(k,jsys)
694 ENDIF
695 ENDIF
696 ENDDO
697 sigtruss(1,jsys)=zero
698 id_sigtruss(jsys)=0
699 ELSE
700 ie =je
701 isys=jsys
702 ENDIF
703 ENDDO
704 compt=0
705 DO j=1,numtrus
706 ie=id_sigtruss(j)
707 IF (ie /= 0) THEN
708 compt=compt+1
709 IF (compt < j) THEN
710 DO k=1,nsigtruss
711 sigtruss(k,compt)=sigtruss(k,j)
712 ENDDO
713 id_sigtruss(compt)=id_sigtruss(j)
714 sigtruss(1,j)=zero
715 id_sigtruss(j)=0
716 ENDIF
717 ENDIF
718 ENDDO
719 numtrus=compt
720 ENDIF ! IF (NUMTRUS > 0)
721C
722 IF (numtrus > 0) THEN
723C tri des elts du Y000 par ID croissant
724 DO isys = 1, numtrus
725 itri(isys) = id_sigtruss(isys)
726 ENDDO
727 CALL my_orders(0,work,itri,index,numtrus,1)
728 DO j = 1, numtrus
729 isys=index(j)
730 ksysusr(j)=id_sigtruss(isys)
731 ksysusr(numtrus+j)=isys
732 ENDDO
733C
734C Nos systeme dans le Y000, des elts du D00
735 DO i=1,numelt
736 isys=uel2sys(ixt(nixt,i),ksysusr,numtrus)
737 pttruss(i) =isys
738 ENDDO
739 ENDIF ! IF (NUMTRUS > 0)
740C
741 RETURN
742 END
743
initia
subroutine initia(iparg, elbuf, ms, in, v, x, ixs, ixq, ixc, ixt, ixp, ixr, detonators, geo, pm, rby, npby, lpby, npc, npts, pld, veul, ale_connectivity, skew, fill, ipart, itab, sensors, skvol, ixtg, thk, nloc_dmg, group_param_tab, glob_therm, igrnod, igrsurf, bufsf, vr, bufmat, xlas, las, dtelem, mss, msq, msc, mst, msp, msr, mstg, ptg, inc, nod2eltg, knod2eltg, inp, inr, intg, index, itri, kxx, ixx, xelemwa, iwa, nod2elq, knod2elq, nod2els, knod2els, kxsp, ixsp, nod2sp, ispcond, icode, iskew, iskn, ispsym, xframe, isptag, spbuf, mssx, nsigi, npbyl, lpbyl, rbyl, msnf, mssf, nsigsh, igeo, ipm, nsigs, nsigsph, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, nshnod, stifint, fxbdep, fxbvit, fxbacc, fxbipm, fxbrpm, fxbelm, fxbsig, fxbmod, ins, ptshel, ptsh3n, ptsol, ptquad, wma, ptsph, fxbnod, mbufel, mdepl, fxani, numel, nsigrs, sh4tree, sh3tree, mcp, temp, imerge2, iadmerge2, slnrbm, nslnrbm, rmstifn, rmstifr, ms_layer, zi_layer, itag, itagel, mcpc, mcptg, xrefc, xreftg, xrefs, mssa, msrt, irbe2, lrbe2, inivol, kvol, nbsubmat, ixs10, ixs16, ixs20, totaddmas, ipmas, stifn, msz2, itagn, sitage, itage, ixr_kj, elbuf_tab, nom_opt, ptr_nopt_rbe2, ptr_nopt_adm, ptr_nopt_fun, sol2sph, irst, sh3trim, xfem_tab, kxig3d, ixig3d, msig3d, knot, nctrlmax, wige, stack, rnoise, drape, sh4ang, sh3ang, geo_stack, igeo_stack, stifintr, strc, strp, strr, strtg, perturb, itagnd, nativ_sms, iloadp, facload, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, multi_fvm, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, iddlevel, inimap1d, inimap2d, func2d, fvm_inivel, tagprt_sms, igrbric, igrquad, igrsh4n, igrsh3n, igrpart, totmas, knotlocpc, knotlocel, vnige, bnige, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxb_matrix, fxb_matrix_add, fxb_last_adress, ptr_nopt_fxb, r_skew, knod2el1d, nod2el1d, ebcs_tab, rby_iniaxis, alea, knod2elc, nod2elc, dr, slrbody, drapeg, ipari, intbuf_tab, interfaces, mat_param, npreload_a, preload_a, fail_fractal, fail_brokmann, defaults, ndamp_freq_range, dampr, ibeam_vector, rbeam_vector, ikine)
Definition initia.F:188
lec_inistate_tri
subroutine lec_inistate_tri(ixs, ixq, ixc, ixt, ixp, ixr, kxsp, ixtg, index, itri, nsigsh, nsigs, nsigsph, ksysusr, ksigsh3, nsigrs, nsigi, nsigbeam, nsigtruss, ptshel, ptsh3n, ptsol, ptquad, ptsph, ptspri, ptbeam, pttruss, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, id_sigsh, id_solid_sigi, id_quad_sigi, id_sigspri, id_sigbeam, id_sigtruss, work, id_sigsphcel, is_state)
Definition lec_inistate_tri.F:43
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
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
starter
program starter
Definition starter.F:39