1 : C EXCHAM SOURCE PV 12/11/24 21:15:00 7573
2 : SUBROUTINE EXCHAM(ICOLAC,ITLACC,M1,M2,IIICHA)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : *--------------------------------------------------------------------*
6 : * *
7 : * Sous-programme appel{ par EXPIL, traitant la pile des *
8 : * nouveaux CHAMELEMs. *
9 : * *
10 : * Param}tres: *
11 : * *
12 : * e ICOLAC pointeur sur le chapeau des piles *
13 : * es ITLACC pointeur de la pile examin{e *
14 : * e M1 premier indice d'examen dans la pile *
15 : * e M2 dernier indice d'examen dans la pile *
16 : * e IIICHA = 1 : on change les pointeurs *
17 : * *
18 : *--------------------------------------------------------------------*
19 : -INC CCOPTIO
20 : -INC SMCHAML
21 : -INC TMCOLAC
22 : *
23 : CHARACTER*8 MOTIP
24 : CHARACTER*16 MOTYP
25 : *
26 : IF (M1.GT.M2) RETURN
27 : *
28 : ICO1 = KCOLA( 1)
29 : ILISSE=ILISSG
30 : SEGACT ILISSE*MOD
31 : DO 10 IEL=M1,M2
32 : MCHELM = ITLAC(IEL)
33 : IF (MCHELM.EQ.0) GO TO 10
34 : SEGACT,MCHELM*MOD
35 : N3 = INFCHE(/2)
36 : if (ichaml(/1).lt.0.or.ichaml(/1).gt.10000000) then
37 : * chelm invalide. On le supprime de la pile
38 : moterr(1:8)='MCHELM '
39 : interr(1)=itlac(iel)
39 : call erreur(861)
40 : itlac(iel)=0
41 : goto 10
42 : endif
43 : DO 20 I=1,ICHAML(/1)
44 : MCHAML = ICHAML(I)
45 : SEGACT,MCHAML*MOD
46 : *
47 : IVA = IMACHE(I)
48 : IF(IVA.GT.0) THEN
48 : CALL AJOUN(ICO1,IVA,ILISSE,1)
49 : IF (IIICHA.EQ.1) IMACHE(I) =-IVA
50 : ENDIF
51 : *
52 : IF(N3.GE.4) THEN
53 : IVA = INFCHE(I,4)
54 : ICO2 = KCOLA(40)
55 : IF(IVA.GT.0) THEN
55 : CALL AJOUN(ICO2,IVA,ILISSE,1)
56 : IF (IIICHA.EQ.1) INFCHE(I,4) =-IVA
57 : ENDIF
58 : ENDIF
59 : *
60 : DO 30 J=1,TYPCHE(/2)
61 : MOTYP = TYPCHE(J)
62 : IF (MOTYP(1:6).NE.'REAL*8') THEN
63 : MOTIP(1:8)=MOTYP(9:16)
63 : CALL TYPFIL(MOTIP,ITYP)
64 : IF (ITYP.GT.0) THEN
65 : NUMLIS=1
66 : IF(ITYP.EQ.24) NUMLIS=6
67 : C IF(ITYP.EQ.25) NUMLIS=4
68 : IF(ITYP.EQ.26) NUMLIS=2
69 : IF(ITYP.EQ.27) NUMLIS=5
70 : IF(ITYP.EQ.32) NUMLIS=3
71 : IF(ITYP.EQ.36) NUMLIS=7
72 : ICO2 = KCOLA(ITYP)
73 : MELVAL = IELVAL(J)
74 : SEGACT,MELVAL*MOD
75 : NAL1 = IELCHE(/1)
76 : NAL2 = IELCHE(/2)
77 : DO 40 I2=1,NAL2
78 : DO 50 I1=1,NAL1
79 : IVA = IELCHE(I1,I2)
80 : IF(IVA.GT.0) THEN
80 : CALL AJOUN(ICO2,IVA,ILISSE,NUMLIS)
81 : IF (IIICHA.EQ.1) IELCHE(I1,I2) =-IVA
82 : ENDIF
83 : 50 CONTINUE
84 : * END DO
85 : 40 CONTINUE
86 : * END DO
87 : SEGDES,MELVAL
88 : ENDIF
89 : ENDIF
90 : 30 CONTINUE
91 : * END DO
92 : SEGDES,MCHAML
93 : 20 CONTINUE
94 : * END DO
95 : SEGDES,MCHELM
96 : 10 CONTINUE
97 : * END DO
98 : *
99 : * SEGDES ILISSE
100 : RETURN
101 : END
102 :
103 :
104 :
105 :
106 :
107 :
108 :
109 :
110 :
111 :
112 :
© Cast3M 2003 - All rights reserved.
Disclaimer