1 : C FUSRIG SOURCE CHAT 09/10/09 21:18:29 6519
2 :
3 : C=======================================================================
4 : C= F U S R I G =
5 : C= ----------- =
6 : C= Ce sousprogramme realise la fusion ('ET') de deux objets RIGIDITE. =
7 : C=======================================================================
8 :
9 : SUBROUTINE FUSRIG (IP1,IP2,IRETOU)
10 :
11 : IMPLICIT INTEGER(I-N)
12 : IMPLICIT REAL*8 (A-H,O-Z)
13 :
14 : -INC CCOPTIO
15 : -INC SMRIGID
16 : -INC SMELEME
17 :
18 : PARAMETER (IVA=2)
19 : DIMENSION ITTG(IVA)
20 :
21 : ITTG(1)=IP1
22 : ITTG(2)=IP2
23 :
24 : NRIGE=0
25 : NRIGEL=0
26 : DO i=1,IVA
27 : MRIGID=ITTG(i)
28 : SEGACT,MRIGID
29 : NRIGE=MAX(IRIGEL(/1),NRIGE)
30 : NRIGEL=NRIGEL+IRIGEL(/2)
31 : C= SEGDES,MRIGID
32 : ENDDO
33 :
34 : SEGINI,MRIGID
35 : ICHOLE=0
36 : IMGEO1=0
37 :
38 : IC=1
39 : DO i=1,IVA
40 : RI1=ITTG(i)
41 : C= SEGACT,RI1
42 : JA=RI1.IRIGEL(/2)
43 : JB=RI1.IRIGEL(/1)
44 : DO k=1,JA
45 : MELEME=RI1.IRIGEL(1,k)
46 : SEGACT,MELEME
47 : IF (NUM(/2).NE.0) THEN
48 : COERIG(IC)=RI1.COERIG(k)
49 : DO l=1,JB
50 : IRIGEL(l,IC)=RI1.IRIGEL(l,k)
51 : ENDDO
52 : IC=IC+1
53 : ENDIF
54 : SEGDES,MELEME
55 : ENDDO
56 : C= SEGDES,RI1
57 : ENDDO
58 :
59 : IF (NRIGEL.NE.(IC-1)) THEN
60 : NRIGEL=IC-1
61 : SEGADJ,MRIGID
62 : ENDIF
63 :
64 : RI1=ITTG(1)
65 : RI2=ITTG(2)
66 : C= SEGACT,RI1,RI2
67 : IF (RI2.MTYMAT.NE.RI1.MTYMAT) THEN
68 : IF (RI1.MTYMAT.EQ.'RIGIDITE'.OR.RI2.MTYMAT.EQ.'RIGIDITE') THEN
69 : MTYMAT='RIGIDITE'
70 : ENDIF
71 : ELSE
72 : MTYMAT=RI1.MTYMAT
73 : ENDIF
74 : SEGDES,RI1,RI2
75 :
76 : C*OF RI1=MRIGID
76 : C= CALL COMPA(MRIGID)
77 : C*OF IF (RI1.NE.MRIGID) SEGSUP,RI1
78 :
79 : SEGDES,MRIGID
80 : IRETOU=MRIGID
81 :
82 : RETURN
83 : END
84 :
85 :
86 :
87 :
88 :
© Cast3M 2003 - All rights reserved.
Disclaimer