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
47 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "scry_c.inc"
58#include "sphcom.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),IXTG(NIXTG,*)
63 INTEGER INDEX(*),ITRI(*),KXSP(*),KSYSUSR(*)
64 INTEGER PTSHEL(*),PTSH3N(*),PTSOL(*),PTQUAD(*),PTSPH(*),PTSPRI(*),PTBEAM(*),PTTRUSS(*)
65 INTEGER NSIGI,NSIGSH,NSIGS, NSIGSPH, NSIGRS, NSIGBEAM, NSIGTRUSS, KSIGSH3
66 INTEGER ID_SIGSH(*), ID_SOLID_SIGI(*), ID_QUAD_SIGI(*)
67 INTEGER ID_SIGSPRI(*), ID_SIGBEAM(*), ID_SIGTRUSS(*)
68 INTEGER WORK(*)
69 my_real
70 . SIGI(NSIGS,*),SIGSH(MAX(1,NSIGSH),*),SIGTRUSS(NSIGTRUSS,*),
71 . sigsp(nsigi,*),sigsph(nsigsph,*),sigrs(nsigrs,*),sigbeam(nsigbeam,*)
72
73 INTEGER, INTENT(INOUT) :: ID_SIGSPHCEL(NUMSPH)
74 LOGICAL, INTENT(IN) :: IS_STATE
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I, J, K
79 INTEGER ISYS,JSYS,II,IE,JE,COMPT,NUMSHEL0
80C-----------------------------------------------
81 EXTERNAL UEL2SYS
82 INTEGER UEL2SYS
83C----------------------------------------------------------------------
84 IF (abs(isigi) == 3.OR.abs(isigi) == 4.OR.abs(isigi) == 5) THEN
85C
86C SHELL 4-NODES
87C
88 numshel0 = numshel
89 IF(numshel>0)THEN
90C sorting elements of Y000 by ascending id
91
92 DO isys = 1, numshel
93 itri(isys) =id_sigsh(isys)
94 END DO
95 CALL my_orders(0,work,itri,index,numshel,1)
96C checking INISHE : search for multiply define
97 isys = index(1)
98 ie = id_sigsh(isys)
99 DO j = 2, numshel
100 jsys=index(j)
101 je =id_sigsh(jsys)
102 IF(je == ie)THEN
103 DO k=2,nsigsh
104 IF(sigsh(k,jsys)/=zero)THEN
105 IF(sigsh(k,isys)/=zero.AND.
106 . sigsh(k,isys)/=sigsh(k,jsys))THEN
107 CALL ancmsg(msgid=595,
108 . msgtype=msgerror,
109 . anmode=aninfo_blind_1,
110 . i1=ie)
111 ELSE
112 sigsh(k,isys)=sigsh(k,jsys)
113 END IF
114 END IF
115 END DO
116 sigsh(1,jsys)=zero
117 id_sigsh(jsys)=0
118 ELSE
119 ie =je
120 isys=jsys
121 END IF
122 END DO
123 compt=0
124 DO j=1,numshel
125 ie=id_sigsh(j)
126 IF(ie/=0)THEN
127 compt=compt+1
128 IF(compt<j)THEN
129 DO k=1,nsigsh
130 sigsh(k,compt)=sigsh(k,j)
131 END DO
132 id_sigsh(compt)=id_sigsh(j)
133
134 sigsh(1,j)=zero
135 id_sigsh(j)=0
136 END IF
137 END IF
138 END DO
139 numshel=compt
140 ENDIF
141C
142 IF(numshel>0)THEN
143C sorting elements of Y000 by ascending id
144
145 DO isys = 1,numshel
146 itri(isys) = id_sigsh(isys)
147 END DO
148 CALL my_orders(0,work,itri,index,numshel,1)
149 DO j = 1, numshel
150 isys=index(j)
151 ksysusr(j)=id_sigsh(isys)
152 ksysusr(numshel+j)=isys
153 END DO
154C
155C our system in Y000, elements of D00
156 DO i=1,numelc
157 isys=uel2sys(ixc(nixc,i),ksysusr,numshel)
158 ptshel(i) =isys
159 END DO
160 ENDIF
161C
162C SHELL 3-NODES
163C
164 IF(numsh3n>0)THEN
165C sorting elements of Y000 by ascending id
166 DO isys = 1, numsh3n
167 ii= numshel0 + isys
168 itri(isys) = id_sigsh(ii)
169 END DO
170 CALL my_orders(0,work,itri,index,numsh3n,1)
171C
172 isys = numshel0 + index(1)
173 ie = id_sigsh(isys)
174 DO j = 2, numsh3n
175 jsys=numshel0+index(j)
176 je =id_sigsh(jsys)
177 IF(je == ie)THEN
178 DO k=2,nsigsh
179 IF(sigsh(k,jsys)/=zero)THEN
180 IF(sigsh(k,isys)/=zero.AND.
181 . sigsh(k,isys)/=sigsh(k,jsys))THEN
182 CALL ancmsg(msgid=596,
183 . msgtype=msgerror,
184 . anmode=aninfo_blind_1,
185 . i1=ie)
186 ELSE
187 sigsh(k,isys)=sigsh(k,jsys)
188 END IF
189 END IF
190 END DO
191 sigsh(1,jsys)=zero
192 id_sigsh(jsys)=0
193 ELSE
194 ie =je
195 isys=jsys
196 END IF
197 END DO
198 compt=0
199 DO j=1,numsh3n
200 ie=id_sigsh(numshel0 + j)
201 IF(ie /=0 )THEN
202 compt=compt+1
203 IF(numshel+compt<numshel0+j)THEN
204 DO k=1,nsigsh
205 sigsh(k,numshel+compt)=sigsh(k,numshel0+j)
206 END DO
207 id_sigsh(numshel+compt)=id_sigsh(numshel0+j)
208
209 sigsh(1,numshel0+j)=zero
210 id_sigsh(numshel0+j)=0
211 END IF
212 END IF
213 END DO
214 numsh3n=compt
215 END IF
216C
217 IF (numsh3n > 0) THEN
218C sorting elements of Y000 by ascending id
219 DO isys = 1, numsh3n
220 ii = isys + numshel0
221 itri(isys) = id_sigsh(ii)
222 END DO
223 CALL my_orders(0,work,itri,index,numsh3n,1)
224C
225 DO j = 1, numsh3n
226 isys = index(j)
227 ii = isys + numshel0
228 ksysusr(j) = id_sigsh(ii)
229 ksysusr(numsh3n + j) = isys
230 END DO
231C
232C our system in Y000, elements of D00
233 DO i=1,numeltg
234 isys = uel2sys(ixtg(nixtg,i),ksysusr,numsh3n)
235 ptsh3n(i) = isys
236 END DO
237 ENDIF
238C
239C BRICK
240C
241 IF(numsol>0)THEN
242C
243C sorting elements of SIGI by ascending id
244 DO isys = 1, numsol
245 itri(isys) = id_solid_sigi(isys)
246 END DO
247 CALL my_orders(0,work,itri,index,numsol,1)
248C
249C checking (search for multiply define) and compacting INISOL
250 isys=index(1)
251 ie =id_solid_sigi(isys)
252 DO j = 2, numsol
253 jsys=index(j)
254 je =id_solid_sigi(jsys)
255 IF(je == ie)THEN
256 DO k=1,6
257 IF((sigi(k,jsys)/=zero) .AND.
258 . (sigi(k,isys)/=sigi(k,jsys)) )THEN
259 IF(sigi(k,isys)/=zero)THEN
260 CALL ancmsg(msgid=597,
261 . msgtype=msgerror,
262 . anmode=aninfo_blind_1,
263 . i1=ie)
264 ELSE
265 sigi(k,isys)=sigi(k,jsys)
266 END IF
267 END IF
268 END DO
269 DO k=8,10
270 IF(sigi(k,jsys)/=zero .AND.
271 . (sigi(k,isys)/=sigi(k,jsys)) )THEN
272 IF(sigi(k,isys)/=zero)THEN
273 CALL ancmsg(msgid=597,
274 . msgtype=msgerror,
275 . anmode=aninfo_blind_1,
276 . i1=ie)
277 ELSE
278 sigi(k,isys)=sigi(k,jsys)
279 END IF
280 END IF
281 END DO
282 DO k=1,nsigi
283 IF(sigsp(k,jsys)/=zero .AND.
284 . (sigsp(k,isys)/=sigsp(k,jsys)) )THEN
285 IF(sigsp(k,isys)/=zero)THEN
286 CALL ancmsg(msgid=597,
287 . msgtype=msgerror,
288 . anmode=aninfo_blind_1,
289 . i1=ie)
290 ELSE
291 sigsp(k,isys)=sigsp(k,jsys)
292 END IF
293 END IF
294 END DO
295 id_solid_sigi(jsys)=0
296 ELSE
297 ie =je
298 isys=jsys
299 END IF
300 END DO
301 compt=0
302 DO j=1,numsol
303 ie=id_solid_sigi(j)
304 IF(ie/=0)THEN
305 compt=compt+1
306 IF(compt<j)THEN
307 DO k=1,6
308 sigi(k,compt)=sigi(k,j)
309 END DO
310 id_solid_sigi(compt)=id_solid_sigi(j)
311 DO k=8,10
312 sigi(k,compt)=sigi(k,j)
313 END DO
314 DO k=1,nsigi
315 sigsp(k,compt)=sigsp(k,j)
316 END DO
317 id_solid_sigi(j)=0
318 END IF
319 END IF
320 END DO
321 numsol=compt
322 END IF
323C
324 IF(numsol>0)THEN
325C
326C sorting elements of Y000 by ascending id
327 DO isys = 1, numsol
328 itri(isys) = id_solid_sigi(isys)
329 END DO
330 CALL my_orders(0,work,itri,index,numsol,1)
331 DO j = 1, numsol
332 isys=index(j)
333 ksysusr(j)=id_solid_sigi(isys)
334 ksysusr(numsol+j)=isys
335 END DO
336C
337C our system in Y000, elements of D00
338 DO i=1,numels
339 isys=uel2sys(ixs(nixs,i),ksysusr,numsol)
340 ptsol(i) =isys
341 END DO
342 END IF
343C
344C QUAD 2D
345C
346 IF(numquad>0)THEN
347C
348C sorting elements of SIGI by ascending id
349 DO isys = 1, numquad
350 itri(isys) = id_quad_sigi(isys)
351 END DO
352 CALL my_orders(0,work,itri,index,numquad,1)
353C
354C checking (search for multiply define) and compacting INIQUA
355 isys=index(1)
356 ie =id_quad_sigi(isys)
357 DO j = 2, numquad
358 jsys=index(j)
359 je =id_quad_sigi(jsys)
360 IF(je == ie)THEN
361 DO k=1,6
362 IF(sigi(k,jsys)/=zero)THEN
363 IF(sigi(k,isys)/=zero)THEN
364 CALL ancmsg(msgid=598,
365 . msgtype=msgerror,
366 . anmode=aninfo_blind_1,
367 . i1=ie)
368 ELSE
369 sigi(k,isys)=sigi(k,jsys)
370 END IF
371 END IF
372 END DO
373 DO k=8,10
374 IF(sigi(k,jsys)/=zero)THEN
375 IF(sigi(k,isys)/=zero)THEN
376 CALL ancmsg(msgid=598,
377 . msgtype=msgerror,
378 . anmode=aninfo_blind_1,
379 . i1=ie)
380 ELSE
381 sigi(k,isys)=sigi(k,jsys)
382 END IF
383 END IF
384 END DO
385 id_quad_sigi(jsys) = 0
386 ELSE
387 ie =je
388 isys=jsys
389 END IF
390 END DO
391 compt=0
392 DO j=1,numquad
393 ie=id_quad_sigi(j)
394 IF(ie/=0)THEN
395 compt=compt+1
396 IF(compt<j)THEN
397 DO k=1,6
398 sigi(k,compt)=sigi(k,j)
399 END DO
400 id_quad_sigi(compt)= id_quad_sigi(j)
401 DO k=8,10
402 sigi(k,compt)=sigi(k,j)
403 END DO
404 id_quad_sigi(j) = 0
405 END IF
406 END IF
407 END DO
408 numquad=compt
409 END IF
410C
411 IF(numquad>0)THEN
412C
413C sorting elements of Y000 by ascending id
414 DO isys = 1, numquad
415 itri(isys) = id_quad_sigi(isys)
416 END DO
417 CALL my_orders(0,work,itri,index,numquad,1)
418 DO j = 1, numquad
419 isys=index(j)
420 ksysusr(j)=id_quad_sigi(isys)
421 ksysusr(numquad+j)=isys
422 END DO
423C
424C our system in Y000, elements of D00
425 DO i=1,numelq
426 isys=uel2sys(ixq(nixq,i),ksysusr,numquad)
427 ptquad(i) =isys
428 END DO
429 END IF
430C
431 END IF ! IF (ABS(ISIGI) == 3.OR.ABS(ISIGI) == 4.OR.ABS(ISIGI) == 5)
432C
433C SPH
434C
435 IF(numsphy>0 .AND. is_state)THEN
436C sorting elements Ids
437 DO isys = 1, numsphy
438 itri(isys) = id_sigsphcel(isys)
439 END DO
440 CALL my_orders(0,work,itri,index,numsphy,1)
441C checking INISPHCEL : search for multiply define
442 isys=index(1)
443 ie = id_sigsphcel(isys)
444
445 DO j = 2, numsphy
446 jsys=index(j)
447 je = id_sigsphcel(jsys)
448 IF (je == ie) THEN
449 DO k=1,nsigsph
450 IF (sigsph(k,jsys) /= zero) THEN
451 IF (sigsph(k,isys) /= zero .AND.
452 . sigsph(k,isys) /= sigsph(k,jsys)) THEN
453 CALL ancmsg(msgid=1234,
454 . msgtype=msgerror,
455 . anmode=aninfo_blind_1,
456 . i1=ie)
457 ELSE
458 sigsph(k,isys)=sigsph(k,jsys)
459 ENDIF
460 ENDIF
461 ENDDO
462 sigsph(1,jsys)=zero
463 id_sigsphcel(jsys)=0
464 ELSE
465 ie =je
466 isys=jsys
467 ENDIF
468 ENDDO
469 compt=0
470 DO j=1,numsphy
471 ie = id_sigsphcel(j)
472 IF (ie /= 0) THEN
473 compt=compt+1
474 IF (compt < j) THEN
475 DO k=1,nsigsph
476 sigsph(k,compt)=sigsph(k,j)
477 ENDDO
478 id_sigsphcel(compt)=id_sigsphcel(j)
479 sigsph(1,j)=zero
480 id_sigsphcel(j)=0
481 ENDIF
482 ENDIF
483 ENDDO
484 numsphy=compt
485
486
487 ENDIF ! IF (NUMSPHY > 0)
488
489
490
491
492 IF (numsphy > 0) THEN
493C sorting elements Ids
494 DO isys = 1, numsphy
495 IF(is_state) THEN
496 itri(isys) = id_sigsphcel(isys)
497 ELSE
498 itri(isys) = nint(sigsph(7,isys))
499 ENDIF
500 END DO
501 CALL my_orders(0,work,itri,index,numsphy,1)
502 DO j = 1, numsphy
503 isys=index(j)
504 IF(is_state) THEN
505 ksysusr(j) = id_sigsphcel(isys)
506 ELSE
507 ksysusr(j) = nint(sigsph(7,isys))
508 ENDIF
509 ksysusr(numsphy+j)=isys
510 END DO
511C
512 DO i=1,numsph
513 isys=uel2sys(kxsp(nisp*i),ksysusr,numsphy)
514 ptsph(i) =isys
515 END DO
516 END IF
517C
518 IF (abs(isigi)<3) THEN
519 ksigsh3=1+numelc
520 ELSE
521 ksigsh3=1+numshel
522 END IF
523C
524C SPRING
525C
526 IF (numspri > 0) THEN
527C
528 inispri = 1
529C sorting elements of Y000 by ascending id
530 DO isys = 1, numspri
531 itri(isys) =id_sigspri(isys)
532 ENDDO
533 CALL my_orders(0,work,itri,index,numspri,1)
534C checking INISPRI : search for multiply define
535 isys=index(1)
536 ie =id_sigspri(isys)
537 DO j = 2, numspri
538 jsys=index(j)
539 je =id_sigspri(jsys)
540 IF (je == ie) THEN
541 DO k=2,nsigrs
542 IF (sigrs(k,jsys) /= zero) THEN
543 IF (sigrs(k,isys) /= zero .AND.
544 . sigrs(k,isys) /= sigrs(k,jsys)) THEN
545 CALL ancmsg(msgid=1234,
546 . msgtype=msgerror,
547 . anmode=aninfo_blind_1,
548 . i1=ie)
549 ELSE
550 sigrs(k,isys)=sigrs(k,jsys)
551 ENDIF
552 ENDIF
553 ENDDO
554 sigrs(1,jsys)=zero
555 id_sigspri(jsys)=0
556 ELSE
557 ie =je
558 isys=jsys
559 ENDIF
560 ENDDO
561 compt=0
562 DO j=1,numspri
563 ie=id_sigspri(j)
564 IF (ie /= 0) THEN
565 compt=compt+1
566 IF (compt < j) THEN
567 DO k=1,nsigrs
568 sigrs(k,compt)=sigrs(k,j)
569 ENDDO
570 id_sigspri(compt)=id_sigspri(j)
571 sigrs(1,j)=zero
572 id_sigspri(j)=0
573 ENDIF
574 ENDIF
575 ENDDO
576 numspri=compt
577 ENDIF ! IF (NUMSPRI > 0)
578C
579 IF (numspri > 0) THEN
580C sorting elements of Y000 by ascending id
581 DO isys = 1, numspri
582 itri(isys) = id_sigspri(isys)
583 ENDDO
584 CALL my_orders(0,work,itri,index,numspri,1)
585 DO j = 1, numspri
586 isys=index(j)
587 ksysusr(j)=id_sigspri(isys)
588 ksysusr(numspri+j)=isys
589 ENDDO
590C
591C our system in Y000, elements of D00
592 DO i=1,numelr
593 isys=uel2sys(ixr(nixr,i),ksysusr,numspri)
594 ptspri(i) =isys
595 ENDDO
596 ENDIF ! IF (NUMSPRI > 0)
597C
598C BEAM
599C
600 IF (numbeam > 0) THEN
601C sorting elements of Y000 by ascending id
602 DO isys = 1, numbeam
603 itri(isys) =id_sigbeam(isys)
604 ENDDO
605 CALL my_orders(0,work,itri,index,numbeam,1)
606C checking INIBEAM : search for multiply define
607 isys=index(1)
608 ie =id_sigbeam(isys)
609 DO j = 2, numbeam
610 jsys=index(j)
611 je =id_sigbeam(jsys)
612 IF (je == ie) THEN
613 DO k=2,nsigbeam
614 IF (sigbeam(k,jsys) /= zero) THEN
615 IF (sigbeam(k,isys) /= zero .AND.
616 . sigbeam(k,isys) /= sigbeam(k,jsys)) THEN
617 CALL ancmsg(msgid=1235,
618 . msgtype=msgerror,
619 . anmode=aninfo_blind_1,
620 . i1=ie)
621 ELSE
622 sigbeam(k,isys)=sigbeam(k,jsys)
623 ENDIF
624 ENDIF
625 ENDDO
626 sigbeam(1,jsys)=zero
627 id_sigbeam(jsys)=0
628 ELSE
629 ie =je
630 isys=jsys
631 ENDIF
632 ENDDO
633 compt=0
634 DO j=1,numbeam
635 ie=id_sigbeam(j)
636 IF (ie /= 0) THEN
637 compt=compt+1
638 IF (compt < j) THEN
639 DO k=1,nsigbeam
640 sigbeam(k,compt)=sigbeam(k,j)
641 ENDDO
642 id_sigbeam(compt)=id_sigbeam(j)
643 sigbeam(1,j)=zero
644 id_sigbeam(j)=0
645 ENDIF
646 ENDIF
647 ENDDO
648 numbeam=compt
649 ENDIF ! IF (NUMBEAM > 0)
650C
651 IF (numbeam > 0) THEN
652C sorting elements of Y000 by ascending id
653 DO isys = 1, numbeam
654 itri(isys) = id_sigbeam(isys)
655 ENDDO
656 CALL my_orders(0,work,itri,index,numbeam,1)
657 DO j = 1, numbeam
658 isys=index(j)
659 ksysusr(j)=id_sigbeam(isys)
660 ksysusr(numbeam+j)=isys
661 ENDDO
662C
663C our system in Y000, elements of D00
664 DO i=1,numelp
665 isys=uel2sys(ixp(nixp,i),ksysusr,numbeam)
666 ptbeam(i) =isys
667 ENDDO
668 ENDIF ! IF (NUMBEAM > 0)
669C
670C TRUSS
671C
672 IF (numtrus > 0) THEN
673C sorting elements of Y000 by ascending id
674 DO isys = 1, numtrus
675 itri(isys) =id_sigtruss(isys)
676 ENDDO
677 CALL my_orders(0,work,itri,index,numtrus,1)
678C checking INITRUSS : search for multiply define
679 isys=index(1)
680 ie =id_sigtruss(isys)
681 DO j = 2, numtrus
682 jsys=index(j)
683 je =id_sigtruss(jsys)
684 IF (je == ie) THEN
685 DO k=2,nsigtruss
686 IF (sigtruss(k,jsys) /= zero) THEN
687 IF (sigtruss(k,isys) /= zero .AND.
688 . sigtruss(k,isys) /= sigtruss(k,jsys)) THEN
689 CALL ancmsg(msgid=1239,
690 . msgtype=msgerror,
691 . anmode=aninfo_blind_1,
692 . i1=ie)
693 ELSE
694 sigtruss(k,isys)=sigtruss(k,jsys)
695 ENDIF
696 ENDIF
697 ENDDO
698 sigtruss(1,jsys)=zero
699 id_sigtruss(jsys)=0
700 ELSE
701 ie =je
702 isys=jsys
703 ENDIF
704 ENDDO
705 compt=0
706 DO j=1,numtrus
707 ie=id_sigtruss(j)
708 IF (ie /= 0) THEN
709 compt=compt+1
710 IF (compt < j) THEN
711 DO k=1,nsigtruss
712 sigtruss(k,compt)=sigtruss(k,j)
713 ENDDO
714 id_sigtruss(compt)=id_sigtruss(j)
715 sigtruss(1,j)=zero
716 id_sigtruss(j)=0
717 ENDIF
718 ENDIF
719 ENDDO
720 numtrus=compt
721 ENDIF ! IF (NUMTRUS > 0)
722C
723 IF (numtrus > 0) THEN
724C sorting elements of Y000 by ascending id
725 DO isys = 1, numtrus
726 itri(isys) = id_sigtruss(isys)
727 ENDDO
728 CALL my_orders(0,work,itri,index,numtrus,1)
729 DO j = 1, numtrus
730 isys=index(j)
731 ksysusr(j)=id_sigtruss(isys)
732 ksysusr(numtrus+j)=isys
733 ENDDO
734C
735C our system in Y000, elements of D00
736 DO i=1,numelt
737 isys=uel2sys(ixt(nixt,i),ksysusr,numtrus)
738 pttruss(i) =isys
739 ENDDO
740 ENDIF ! IF (NUMTRUS > 0)
741C
742 RETURN
743 END
744
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:1257
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
starter
program starter
Definition starter.F:39
yctrl
subroutine yctrl(igrbric)
Definition yctrl.F:35
uel2sys
integer function uel2sys(iu, ksysusr, numel)
Definition yctrl.F:407