1 : C MECHAM SOURCE PV 10/06/15 21:15:15 6692
2 : SUBROUTINE MECHAM(ILISSE,IPLIS,IPOLAC)
3 : *--------------------------------------------------------------------*
4 : * *
5 : * Sous-programme de la directive MENAGE: nouveau CHAMELEM *
6 : * _______________________________________________________ *
7 : * *
8 : * Param}tres: *
9 : * *
10 : * es IPLIS pointeur sur le segment ISLIS ( suppos{ actif ) *
11 : * es IPOLAC pointeur sur le segment ICOLAC ( suppos{ actif ) *
12 : * *
13 : *--------------------------------------------------------------------*
14 : IMPLICIT INTEGER(I-N)
15 : -INC CCOPTIO
16 : -INC SMCHAML
17 : -INC TMCOLAC
18 : SEGMENT ISLIS(NP)
19 : SEGMENT ISEG(0)
20 : *
21 : ISLIS = IPLIS
22 : ICOLAC = IPOLAC
23 : *
24 : * Cas du nouveau CHAMELEM : MCHAML
25 : *
26 : ITLACC = KCOLA(39)
27 : DO 10 I=1,ITLAC(/1)
28 : MCHELM = ITLAC(I)
29 : IF (MCHELM.NE.0) THEN
30 : ISLIS(( MCHELM-1)/npgcd)=1
31 : SEGACT,MCHELM
32 : N3=INFCHE(/2)
33 : DO 20 J=1,ICHAML(/1)
34 : MCHAML = ICHAML(J)
35 : IF (MCHAML.NE.0) THEN
36 : ISLIS((MCHAML-1)/npgcd)=1
37 : SEGACT,MCHAML
38 : IF(N3.GE.4) THEN
39 : ISEG=INFCHE(J,4)
40 : IF(ISEG.NE.0) THEN
41 : ISLIS((ISEG-1)/npgcd)=1
42 : SEGDES ISEG
43 : ENDIF
44 : ENDIF
45 : DO 30 K=1,IELVAL(/1)
46 : MELVAL = IELVAL(K)
47 : IF (MELVAL.NE.0) THEN
48 : ISLIS((MELVAL-1)/npgcd)=1
49 : IF(TYPCHE(K)(1:8).EQ.'POINTEUR' .AND.
50 : * TYPCHE(K)(9:13).NE.'POINT' .AND.
51 : * TYPCHE(K)(9:15).NE.'LOGIQUE' .AND.
52 : * TYPCHE(K)(9:11).NE.'MOT' ) THEN
53 : SEGACT MELVAL
54 : NAL1=IELCHE(/1)
55 : NAL2=IELCHE(/2)
56 : DO 40 I2=1,NAL2
57 : DO 50 I1=1,NAL1
58 : ISEG=IELCHE(I1,I2)
59 : IF(ISEG.NE.0) THEN
60 : ISLIS((ISEG-1)/npgcd)=1
61 : SEGDES ISEG
62 : ENDIF
63 : 50 CONTINUE
64 : *
65 : 40 CONTINUE
66 : *
67 : ENDIF
68 : SEGDES,MELVAL
69 : ENDIF
70 : 30 CONTINUE
71 : * END DO
72 : SEGDES,MCHAML
73 : ENDIF
74 : 20 CONTINUE
75 : * END DO
76 : SEGDES,MCHELM
77 : ENDIF
78 : 10 CONTINUE
79 : * END DO
80 : *
81 : RETURN
82 : END
83 :
84 :
85 :
86 :
87 :
88 :
89 :
90 :
91 :
© Cast3M 2003 - All rights reserved.
Disclaimer