1 : C LIMODL SOURCE FANDEUR 14/01/22 21:15:09 7891
2 : SUBROUTINE LIMODL(IURES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU
3 : & ,NBANC)
4 : IMPLICIT INTEGER(I-N)
5 : IMPLICIT REAL*8(A-H,O-Z)
6 : *--------------------------------------------------------------------*
7 : * *
8 : * LECTURE D'UN NOUVEAU MODELE SUR LE FICHIER IORES. *
9 : * *
10 : * Param}tres: *
11 : * *
12 : * IORES Num{ro du fichier de sortie *
13 : * ITLACC Pile contenant les nouveaux MODELEs *
14 : * IMAX1 Nombre de MODELEs dans la pile *
15 : * IFORM Si sauvegarde en format ou non *
16 : * *
17 : * APPEL{ PAR: LIPIL *
18 : * *
19 : * Auteur, date de cr{ation: *
20 : * *
21 : * Denis ROBERT-MOUGIN, le 5 juillet 1989. *
22 : * *
23 : *--------------------------------------------------------------------*
24 : -INC CCOPTIO
25 : *
26 : -INC SMMODEL
27 : -INC SMLMOTS
28 : *
29 : SEGMENT,ITLACC
30 : INTEGER ITLAC(0)
31 : ENDSEGMENT
32 : SEGMENT,MTABE1
33 : INTEGER ITABE1(NM1)
34 : ENDSEGMENT
35 : SEGMENT,MTABE2
36 : CHARACTER*(8) ITABE2(NM2)
37 : ENDSEGMENT
38 : SEGMENT,MTABE3
39 : CHARACTER*(8) ITABE3(NM3)
40 : ENDSEGMENT
41 : SEGMENT,MTABE4
42 : INTEGER ITABE4(NM4)
43 : ENDSEGMENT
44 : SEGMENT,MTABE5
45 : CHARACTER*(8) ITABE5(NM5)
46 : ENDSEGMENT
47 : SEGMENT,MTABE6
48 : CHARACTER*(8) ITABE6(NM6)
49 : ENDSEGMENT
50 : SEGMENT MTAB6B
51 : CHARACTER*(4) ITAB6B(NM6)
52 : ENDSEGMENT
53 : SEGMENT,MTABE7
54 : CHARACTER*(8) ITABE7(NM7)
55 : ENDSEGMENT
56 : SEGMENT,MTABE8
57 : Integer ITABE8(NM7)
58 : ENDSEGMENT
59 : SEGMENT MTABE9
60 : Integer ITABE9(nm9)
61 : ENDSEGMENT
62 : *
63 : INTEGER IDAN(10)
64 : * maj modele externe (visco_externe ou utilisateur)
65 : CHARACTER*16 MOMODL(10)
66 : *
67 : * write(6,*) ' niveau limodl ', niveau
68 : N45=5
69 : IF(NIVEAU.GE.12) N45=6
70 : NIDAN=4
71 : if( niveau.ge.13) nidan = 7
72 : if(niveau.ge.15) nidan=10
73 : IRETOU=0
74 : MN3=0
75 : NM7=0
76 : *
77 : * Boucle sur les MODELEs contenus dans la pile:
78 : *
79 : DO 10 IEL=1,IMAX1
80 : DO 110 INI=1,NIDAN
81 : IDAN(INI) = 0
82 : 110 CONTINUE
82 : CALL LFCDIE(IURES,NIDAN,IDAN,IRETOU,IFORM)
83 : IF(IRETOU.NE.0) RETURN
84 : N1 =IDAN(1)
85 : NM2 =IDAN(2)
86 : NM3 =IDAN(3)
87 : NM4 =IDAN(4)
88 : idecmo=2
89 : NM5 = N1 * idecmo
90 : if(niveau.ge.13) then
91 : nm5=idan(5)
92 : idecmo=nm5/n1
93 : n45=idan(6)
94 : nm6=idan(7)
95 : segini mtabe6
96 : segini mtab6b
97 : endif
98 : if(niveau.ge.15) then
99 : nm7=idan(8)
100 : segini mtabe7,mtabe8
101 : endif
102 : *
103 : SEGINI MMODEL
104 : NM1 = N1 * N45
105 : nm9=n1*16
106 : segini,mtabe9
107 : SEGINI,MTABE1
108 : SEGINI,MTABE2
109 : SEGINI,MTABE3
110 : * IF(NIVEAU.GE.4) THEN
111 : SEGINI,MTABE4
112 : SEGINI,MTABE5
113 : * ENDIF
114 : *
114 : CALL LFCDIE(IURES,NM1,ITABE1,IRETOU,IFORM)
114 : if(n45.gt.28) call lfcdie(IURES,NM9,ITABE9,IRETOU,IFORM)
115 : * write(6,*) ' itabe1 '
116 : * write(6,fmt='(10i5)' ) (itabe1(iau),iau=1,nm1)
117 : IF(IRETOU.NE.0) RETURN
118 : * IF(NIVEAU.GE.4) THEN
119 : * write(6,*) 'nm1 nm2 nm3 nm4 nm5 nm6 nm7 '
120 : * write(6,*) nm1, nm2 ,nm3, nm4, nm5, nm6, nm7
120 : CALL LFCDIN(IURES,NM5,ITABE5,IRETOU,IFORM)
121 : IF(IRETOU.NE.0) RETURN
122 : * ENDIF
122 : CALL LFCDIN(IURES,NM2,ITABE2,IRETOU,IFORM)
123 : IF(IRETOU.NE.0) RETURN
123 : CALL LFCDIN(IURES,NM3,ITABE3,IRETOU,IFORM)
124 : IF(IRETOU.NE.0) RETURN
125 : * IF(NIVEAU.GE.4) THEN
125 : CALL LFCDIE(IURES,NM4,ITABE4,IRETOU,IFORM)
126 : IF(IRETOU.NE.0) RETURN
127 : * ENDIF
128 : if(niveau.ge.14) then
128 : call lfcdin(iores,nm6,itabe6,iretou,iform)
129 : IF(IRETOU.NE.0) RETURN
130 : ENDIF
131 : if(niveau.eq.13) then
131 : call lfcden(iores,nm6,itab6b,iretou,iform)
132 : if(iretou.ne.0) return
133 : endif
134 : if(niveau.ge.15.and.nm7.ne.0) then
134 : call LFCDIN(IURES,NM7,ITABE7,IRETOU,IFORM)
135 : * write(6,*) 'nm7 ' , nm7
136 : * write(6,*) 'itabe7 ',( itabe7(iou),iou=1,nm7)
137 : if(iretou.ne.0) return
137 : CALL LFCDIE(IURES,NM7,ITABE8,IRETOU,IFORM)
138 : * write(6,*)'itabe8 ', ( itabe8(iou),iou=1,nm7)
139 : if(iretou.ne.0) return
140 : endif
141 :
142 : * BOUCLES SUR LES ZONES {L{MENTAIRES DU MODELE:
143 : *
144 : JFOR= 0
145 : * write(6,*) ' N45 ' , n45
146 : JMAT= 0
147 : JINF= 0
148 : JNOMID=0
149 : nparmo=0
150 : jobj=0
151 : nobmod=0
152 : jderiv=0
153 : DO 20 ISOUEL=1,N1
154 : ISOU = N45 * ( ISOUEL - 1 )
155 : NFOR = ITABE1(ISOU+3)
156 : NMAT = ITABE1(ISOU+4)
157 : if(niveau.ge.13) nparmo= itabe1(isou+10)
158 : if(niveau.ge.15) nobmod = itabe1(isou+11)
159 : if(n45.ge.37) nobmod=itabe1(isou+37)
160 : if(n45.ge.38) then
161 : jderiv=itabe1(isou+38)
162 : else
163 : jderiv=mepsil
164 : endif
165 : IF(NIVEAU.GE.4) MN33 = ITABE1(ISOU+5)
166 : mn3=mn33
167 : if(n45.lt.28) mn3=7
168 : *
169 : * write(6,*) ' nparmo nm3 ', nparmo ,mn3
170 : SEGINI IMODEL
171 : CONMOD=' '
172 : KMODEL(ISOUEL) = IMODEL
173 : IMAMOD = ITABE1(ISOU+1)
174 : NEFMOD = ITABE1(ISOU+2)
175 : IF(NIVEAU.GE.12) THEN
176 : IPDPGE= ITABE1(ISOU+6)+NBANC
177 : IF (NSDPGE. LT. IPDPGE)NSDPGE= IPDPGE
178 : ENDIF
179 : ideriv=jderiv
180 : * IF(NIVEAU.GE.4) THEN
181 : CONMOD(1:8) = ITABE5(idecmo*(ISOUEL-1)+1)
182 : CONMOD(9:16)= ITABE5(idecmo*(ISOUEL-1)+2)
183 : if(niveau.ge.13) then
184 : if(n45.le.28) then
185 : conmod(17:24)= ITABE5(idecmo*(ISOUEL-1)+3)
186 : llmova= ITABE1(ISOU+7)
187 : llmoma= ITABE1(ISOU+8)
188 : llfama= ITABE1(ISOU+9)
189 : * write(6,*)'llmova llmoma llfama',llmova,llmoma,llfama
190 : else
191 : conmod(17:24)= ITABE5(idecmo*(ISOUEL-1)+3)
192 : cmatee=ITABE5(idecmo*(ISOUEL-1)+4)
193 : imatee=itabe1(isou+7)
194 : inatuu=itabe1(isou+8)
195 : do iyu=1,16
196 : infele(iyu)=itabe9( iyu+(isouel-1)*16)
197 : enddo
198 : endif
199 : endif
200 : *
201 : DO 30 IFOR=1,NFOR
202 : JFOR = JFOR + 1
203 : FORMOD(IFOR)(1:8) = ITABE2(JFOR)
204 : JFOR = JFOR + 1
205 : FORMOD(IFOR)(9:16) = ITABE2(JFOR)
206 : 30 CONTINUE
207 : *
208 : iplu=0
209 : do ioy=1,nfor
210 : if(formod(ioy).eq.'CONVECTION ' ) then
211 : iplu=1
212 : formod(ioy)='THERMIQUE'
213 : endif
214 : enddo
215 : DO 40 IMAT=1,NMAT
216 : JMAT = JMAT + 1
217 : MATMOD(IMAT)(1:8) = ITABE3(JMAT)
218 : JMAT = JMAT + 1
219 : MATMOD(IMAT)(9:16) = ITABE3(JMAT)
220 : 40 CONTINUE
221 : if(iplu.eq.1) then
222 : nmat=nmat+1
223 : segadj imodel
224 : matmod(nmat)='CONVECTION '
225 : endif
226 : *
227 : * IF(NIVEAU.GE.4) THEN
228 : DO 50 IMN3=1,MN33
229 : JINF = JINF + 1
230 : INFMOD(IMN3) = ITABE4(JINF)
231 : 50 CONTINUE
232 : * write(6,*) ' nm3infmod', mn3,(infmod(iou),iou=1,mn3)
233 : * ENDIF
234 : if ( niveau.ge.13) then
235 : if(n45.le.28) then
236 : lmotva=0
237 : lmotma=0
238 : lmotmf=0
239 : lmotpa=0
240 : jgn=4
241 : jgm=llmova
242 : nbrobl=llmova
243 : nbrfac=0
244 : if(nbrobl.ne.0) then
245 : segini mlmots
246 : lmotva=mlmots
247 : do inm6=1,nbrobl
248 : jnomid=jnomid+1
249 : * write(6,*) ' jnomid1' , jnomid
250 : mots(inm6)=itabe6(jnomid)
251 : enddo
252 : endif
253 : nbrobl=llmoma
254 : nbrfac=llfama
255 : if(nbrobl.ne.0) then
256 : jgm=nbrobl
257 : segini mlmots
258 : lmotma=mlmots
259 : do inm6=1,nbrobl
260 : jnomid=jnomid+1
261 : * write(6,*) ' jnomid2 ' , jnomid
262 : mots(inm6)=itabe6(jnomid)
263 : enddo
264 : endif
265 : if(nbrfac.ne.0) then
266 : jgm=nbrfac
267 : segini mlmots
268 : lmotmf=mlmots
269 : do inm6=1,nbrfac
270 : jnomid=jnomid+1
271 : * write(6,*) ' jnomid3 ' , jnomid
272 : mots(inm6)=itabe6(jnomid)
273 : enddo
274 : endif
275 : if(nparmo.ne.0) then
276 : jgm=nparmo
277 : segini mlmots
278 : lmotpa=mlmots
279 : do inm6=1,nparmo
280 : jnomid=jnomid+1
281 : mots(inm6)=itabe6(jnomid)
282 : enddo
283 : endif
284 : IF (FORMOD(1).NE.'NAVIER_STOKES'.AND.FORMOD(1).NE.'EULER') THEN
284 : call inomid(imodel,' ',iret,lmotva,lmotma,
285 : $ lmotmf,lmotpa)
286 : ENDIF
287 : IF(FORMOD(1).EQ.'MECANIQUE'.or.formod(1).eq.'POREUX'.or.
288 : $ FORMOD(1).EQ.'DIFFUSION'.or.formod(1).eq.'ELECTROSTATIQUE'.or.
289 : $ formod(/2).eq.2) then
289 : call prquoi(imodel)
290 : ENDIF
291 : else
292 : do iou=1,14
293 : nbrobl=itabe1(isou+7+2*iou)
294 : nbrfac=itabe1(isou+8+2*iou)
295 : if(nbrobl+nbrfac.ne.0) then
296 : segini nomid
297 : lnomid(iou)=nomid
298 : do iyto=1,nbrobl
299 : jnomid=jnomid+1
300 : lesobl(iyto)=itabe6(jnomid)
301 : enddo
302 : do iyto=1,nbrfac
303 : jnomid=jnomid+1
304 : lesfac(iyto)=itabe6(jnomid)
305 : enddo
306 : segdes nomid
307 : endif
308 : enddo
309 : endif
310 : endif
311 : if(niveau.ge.15) then
312 : * write(6,*) ' nobmod job' , nobmod,jobj
313 : do 15 ihy = 1, nobmod
314 : jobj=jobj+1
315 : tymode(ihy)=itabe7(jobj)
316 : ivamod(ihy)=itabe8(jobj)
317 : 15 continue
318 : endif
319 : *Petite modification en cas de modele externe :
320 : if (formod(/2).eq.1) then
321 : if (formod(1).EQ.'MECANIQUE' .OR.
322 : & formod(1).EQ.'POREUX') then
323 : if (inatuu.ge.0) goto 200
324 : iumat = 0
325 : ivisc = 0
326 : iviex = 0
327 : do i = 1, nmat
328 : if (matmod(i).EQ.'NON_LINEAIRE') iumat = i
329 : if (matmod(i).EQ.'VISCO_EXTERNE') ivisc = i
330 : enddo
331 : if (iumat.ne.0) then
332 : if (matmod(iumat+1).ne.'UTILISATEUR') then
333 : write(ioimp,*) 'maj modele umat incorrect'
333 : call erreur(5)
334 : return
335 : endif
336 : inatuu = -1
337 : endif
338 : if (ivisc.ne.0) then
339 : if (inatuu.eq.-2) goto 200
340 : c* mise a jour du modele
340 : call modvix(momodl,nmod)
340 : call place(momodl,nmod,iviex,matmod(ivisc+1))
341 : if (iviex.eq.0) then
342 : write(ioimp,*) 'MAJ modele iviex incorrect'
342 : call erreur(5)
343 : return
344 : endif
345 : inatuu = -2
346 : nobmod = nobmod + 1
347 : segadj,imodel
348 : tymode(nobmod+1)='IVIEX '
349 : ivamod(nobmod+1)=iviex
350 : endif
351 : 200 continue
352 : endif
353 : endif
354 : *Petite verification en diffusion
355 : if (formod(1).eq.'DIFFUSION') then
356 : if (niveau.lt.17) then
357 : write(ioimp,*) 'Incompatibilite de niveau !'
357 : call erreur(5)
358 : endif
358 : call vermdi(tymode(1),tymode(2))
359 : if (ierr.ne.0) then
360 : write(ioimp,*) 'Revoir votre mise en donnees !'
360 : call erreur(5)
361 : endif
362 : endif
363 : *
364 : SEGDES IMODEL
365 : 20 CONTINUE
366 : *
367 : SEGSUP,MTABE1,MTABE2,MTABE3
368 : * IF(NIVEAU.GE.4) THEN
369 : SEGSUP,MTABE4,MTABE5
370 : * ENDIF
371 : if(niveau.ge.14)segsup mtabe6
372 : if(niveau.ge.13) segsup mtab6b
373 : if(niveau.ge.15) segsup mtabe7,mtabe8
374 : SEGDES MMODEL
375 : ITLAC(**) = MMODEL
376 : *
377 : 10 CONTINUE
378 : *
379 : RETURN
380 : END
381 :
382 :
© Cast3M 2003 - All rights reserved.
Disclaimer