1 : C IDENT SOURCE PV 11/03/08 21:15:40 6888
2 : SUBROUTINE IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRET)
3 : *--------------------------------------------------------------------*
4 : * *
5 : * Verfication de compatibilit{ de MCHAML du point de vue des *
6 : * tableaux INFCHE et creation du tableau INFOS pour COMCHA *
7 : * *
8 : * *
9 : * Entr{es: *
10 : * *
11 : * IPMAIL Pointeur de la sous zone consid{r{e *
12 : * CONM NOM DU CONSTITUANT *
13 : * IPCHE1 Pointeur sur un MCHAML *
14 : * IPCHE2 Pointeur sur un MCHAML *
15 : * *
16 : * Sorties: *
17 : * *
18 : * INFOS tableau de INFCHE a injecter dans COMCHA *
19 : * IRET 1 si compatibles, 0 sinon *
20 : * *
21 : *--------------------------------------------------------------------*
22 : *
23 : IMPLICIT INTEGER(I-N)
24 : -INC CCOPTIO
25 : -INC SMCHAML
26 : *
27 : INTEGER INFOS(*)
28 : CHARACTER*4 NOHA1,NOHA2
29 : CHARACTER*(*) CONM
30 : *
31 : INFOS(1)=0
32 : INFOS(2)=0
33 : INFOS(3)=0
34 : IFLAG=0
35 : IRET =1
36 : *
37 : IF (IFOUR.NE.1) THEN
38 : INFOS(3)=NIFOUR
39 : *
40 : ELSE IF (IPCHE2.EQ.0) THEN
41 : MCHELM=IPCHE1
42 : SEGACT MCHELM
43 : NSOUS1=IMACHE(/1)
44 : DO 200 ISOUS=1,NSOUS1
45 : IF (IPMAIL.EQ.IMACHE(ISOUS).AND.CONM.EQ.CONCHE(ISOUS))
46 : $ GOTO 205
47 : 200 CONTINUE
47 : CALL ERREUR(472)
48 : IRET=0
49 : GOTO 9999
50 : *
51 : 205 CONTINUE
52 : NHRM =INFCHE(ISOUS,3)
53 : INFOS(3)=NHRM
54 : *
55 : ELSE IF (IPCHE1.EQ.0) THEN
56 : MCHELM=IPCHE2
57 : SEGACT MCHELM
58 : NSOUS1=IMACHE(/1)
59 : DO 300 ISOUS=1,NSOUS1
60 : IF (IPMAIL.EQ.IMACHE(ISOUS).AND.CONM.EQ.CONCHE(ISOUS))
61 : $ GOTO 305
62 : 300 CONTINUE
62 : CALL ERREUR(472)
63 : IRET=0
64 : GOTO 9999
65 : *
66 : 305 CONTINUE
67 : NHRM =INFCHE(ISOUS,3)
68 : INFOS(3)=NHRM
69 : ELSE
70 : MCHELM=IPCHE1
71 : SEGACT MCHELM
72 : MCHEL1=IPCHE2
73 : SEGACT MCHEL1
74 : NSOUS1=IMACHE(/1)
75 : NSOUS2=MCHEL1.IMACHE(/1)
76 : *
77 : DO 100 ISOUS=1,NSOUS1
78 : IF (IPMAIL.EQ.IMACHE(ISOUS).AND.CONM.EQ.CONCHE(ISOUS))
79 : $ GOTO 105
80 : 100 CONTINUE
80 : CALL ERREUR(472)
81 : IRET=0
82 : GOTO 9999
83 : *
84 : 105 CONTINUE
85 : NHRM =INFCHE(ISOUS,3)
86 : *
87 : DO 110 JSOUS=1,NSOUS2
88 : IF (IPMAIL.EQ.MCHEL1.IMACHE(JSOUS) .AND.
89 : $ CONM.EQ.MCHEL1.CONCHE(JSOUS)) GOTO 120
90 : 110 CONTINUE
90 : CALL ERREUR(472)
91 : IRET=0
92 : GOTO 9999
93 : *
94 : 120 CONTINUE
95 : WRITE(NOHA1,FMT='(A4)') NHRM
96 : WRITE(NOHA2,FMT='(A4)') MCHEL1.INFCHE(JSOUS,3)
97 : IF (NHRM.EQ.MCHEL1.INFCHE(JSOUS,3).OR.NOHA1.EQ.'NOHA'.OR.
98 : 1 NOHA2.EQ.'NOHA') THEN
99 : IF (IFLAG.EQ.0) THEN
100 : IFLAG=1
101 : INFOS(3)=NHRM
102 : ELSE IF (NHRM.NE.INFOS(3)) THEN
102 : CALL ERREUR(473)
103 : IRET=0
104 : GOTO 9999
105 : ENDIF
106 : ENDIF
107 : ENDIF
108 : *
109 : 9999 RETURN
110 : END
111 :
112 :
113 :
114 :
© Cast3M 2003 - All rights reserved.
Disclaimer