1 : C LICHAM SOURCE PV 09/03/12 21:27:28 6325
2 : SUBROUTINE LICHAM(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : *--------------------------------------------------------------------*
6 : * *
7 : * LECTURE D'UN NOUVEAU CHAMELEM SUR LE FICHIER IORES. *
8 : * *
9 : * Param}tres: *
10 : * *
11 : * IORES NUM{RO DU FICHIER DE LECTURE *
12 : * ITLACC Pile contenant les nouveaux CHAMELEMs *
13 : * IMAX1 Nombre de CHAMELEMs dans la pile *
14 : * IFORM Si sauvegarde en format ou non *
15 : * *
16 : * APPEL{ PAR: LIPIL *
17 : * *
18 : * Auteur, date de cr{ation: *
19 : * *
20 : * Denis ROBERT-MOUGIN, le 29 juin 1989. *
21 : * *
22 : *--------------------------------------------------------------------*
23 : -INC SMCHAML
24 : -INC CCFXDR
25 : *
26 : SEGMENT,ITLACC
27 : INTEGER ITLAC(0)
28 : ENDSEGMENT
29 : SEGMENT,MTABE1
30 : INTEGER ITABE1(NM1)
31 : ENDSEGMENT
32 : SEGMENT,MTABE2
33 : INTEGER ITABE2(NM2)
34 : ENDSEGMENT
35 : SEGMENT,MTABE4
36 : CHARACTER*(8) ITABE4(NM4)
37 : ENDSEGMENT
38 : SEGMENT,MTABE5
39 : CHARACTER*(8) ITABE5(NM5)
40 : ENDSEGMENT
41 : SEGMENT,MTABE6
42 : CHARACTER*(8) ITABE6(NM6)
43 : ENDSEGMENT
44 : *
45 : INTEGER IDAN(4)
46 : IRETOU=0
47 : NM5=0
48 : *
49 : * Boucle sur les CHAMELEMs contenus dans la pile:
50 : *
51 : DO 10 IEL=1,IMAX1
52 : *
53 : MCHELM = 0
54 : *
55 : * CREATION ET REMPLISSAGE DU SEGMENT MCHELM
56 : *
56 : CALL LFCDIE(IORES,4,IDAN,IRETOU,IFORM)
57 : IF(IRETOU.NE.0) RETURN
58 : *
59 : N1 = IDAN(1)
60 : N3 = IDAN(3)
61 : L1 = IDAN(4)
62 : SEGINI MCHELM
63 : IFOCHE = IDAN(2)
63 : CALL LFCDIC(IORES,TITCHE,IRETOU,IFORM)
64 : IF(IRETOU.NE.0) RETURN
65 : *
66 : N6 = N3 + 3
67 : NM1 = N1 * N6
68 : SEGINI,MTABE1
68 : CALL LFCDIE(IORES,NM1,ITABE1,IRETOU,IFORM)
69 : IF(IRETOU.NE.0) RETURN
70 : IF(NIVEAU.GE.4) THEN
71 : NM5 = N1 * 2
72 : SEGINI,MTABE5
72 : CALL LFCDIN(IORES,NM5,ITABE5,IRETOU,IFORM)
73 : IF(IRETOU.NE.0) RETURN
74 : ENDIF
75 : if(niveau.ge.15) then
76 : nm6=n1
77 : segini mtabe6
77 : CALL LFCDIN(IORES,NM6,ITABE6,IRETOU,IFORM)
78 : endif
79 : *
80 : DO 21 ISOUEL=1,N1
81 : ISOU = N6 * (ISOUEL - 1)
82 : IMACHE(ISOUEL) = ITABE1(ISOU+1)
83 : N2 = ITABE1(ISOU+3)
84 : SEGINI MCHAML
85 : ICHAML(ISOUEL)=MCHAML
86 : DO 12 IJ=1,N3
87 : 12 INFCHE(ISOUEL,IJ) = ITABE1(ISOU+3+IJ)
88 : IF(NIVEAU.GE.4) THEN
89 : CONCHE(ISOUEL)(1:8) = ITABE5(2*ISOUEL-1)
90 : CONCHE(ISOUEL)(9:16)= ITABE5(2*ISOUEL )
91 : ELSE
92 : CONCHE(ISOUEL) = ' '
93 : ENDIF
94 : if(niveau.ge.15) then
95 : conche(isouel)(17:24) =itabe6(isouel)
96 : else
97 : conche(isouel)(17:24) =' '
98 : endif
99 : 21 CONTINUE
100 : SEGSUP MTABE1
101 : IF(NIVEAU.GE.4) SEGSUP MTABE5
102 : if(niveau.ge.15) segsup mtabe6
103 : *
104 : * BOUCLES SUR LES ZONES {L{MENTAIRES DU CHAMELEM :
105 : *
106 : DO 22 ISOUEL=1,N1
107 : MCHAML = ICHAML(ISOUEL)
108 : N2 = NOMCHE(/2)
109 : NM2=N2
110 : NM4=N2*2
111 : SEGINI MTABE2,MTABE4
111 : CALL LFCDIE(IORES,NM2,ITABE2,IRETOU,IFORM)
112 : IF(IRETOU.NE.0) RETURN
112 : CALL LFCDIN(IORES,NM2,NOMCHE,IRETOU,IFORM)
113 : IF(IRETOU.NE.0) RETURN
113 : CALL LFCDIN(IORES,NM4,ITABE4,IRETOU,IFORM)
114 : IF(IRETOU.NE.0) RETURN
115 : *
116 : DO 31 ICO=1,N2
117 : if (iform.ne.2) then
118 : WRITE(TYPCHE(ICO),FMT='(2A8)') ITABE4(2*ICO-1),
119 : & ITABE4(2*ICO)
120 : else
121 : TYPCHE(ICO)(1:8) =ITABE4(2*ICO-1)
122 : TYPCHE(ICO)(9:16)=ITABE4(2*ICO )
123 : endif
124 : * write (6,*) ' licham ico typche ',ico,typche(ico)
125 :
126 : *
127 : * PETITS TEST MILL 17 / 1 /92
128 : *
129 : IF(TYPCHE(ICO).EQ.'POINTEUR MLREEL' )
130 : . TYPCHE(ICO)='POINTEURLISTREEL'
131 : IF(TYPCHE(ICO).EQ.'POINTEUR MEVOLUT' )
132 : . TYPCHE(ICO)='POINTEUREVOLUTIO'
133 : *
134 : 31 CONTINUE
135 : *
136 : SEGSUP MTABE2,MTABE4
137 : *
138 : * BOUCLE SUR LES COMPOSANTES :
139 : *
140 : DO 32 ICO=1,N2
140 : CALL LFCDIE(IORES,4,IDAN,IRETOU,IFORM)
141 : IF(IRETOU.NE.0) RETURN
142 : N1PTEL = IDAN (1)
143 : N1EL = IDAN (2)
144 : N2PTEL = IDAN (3)
145 : N2EL = IDAN (4)
146 : * write (6,*) ' licham ',n1ptel,n1el,n2ptel,n2el
147 : SEGINI MELVAL
148 : IELVAL(ICO) = MELVAL
149 : *
150 : * LECTURE DU CONTENU DU SEGMENT MELVAL :
151 : *
152 : L1 = IDAN(1) * IDAN(2)
153 : L2 = IDAN(3) * IDAN(4)
153 : CALL LFCDI2(IORES,L1,VELCHE,IRETOU,IFORM)
154 : IF(IRETOU.NE.0) RETURN
154 : CALL LFCDIE(IORES,L2,IELCHE,IRETOU,IFORM)
155 : IF(IRETOU.NE.0) RETURN
156 : SEGDES MELVAL
157 : 32 CONTINUE
158 : *
159 : SEGDES MCHAML
160 : 22 CONTINUE
161 : *
162 : SEGDES MCHELM
163 : ITLAC(**)=MCHELM
164 : 10 CONTINUE
165 : *
166 : RETURN
167 : END
168 :
169 :
170 :
171 :
172 :
173 :
174 :
© Cast3M 2003 - All rights reserved.
Disclaimer