1 : C DYNE74 SOURCE CHAT 11/03/16 21:19:45 6902
2 : SUBROUTINE DYNE74(ITSORT,ITCARA,ITABL,ITLIA,KTRAV,II,NLS,NVAR)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : *--------------------------------------------------------------------*
6 : * *
7 : * Operateur DYNE : algorithme de Fu - de Vogelaere *
8 : * ________________________________________________ *
9 : * *
10 : * Dimensionne les variables NLS et NVAR, gestion des demandes de *
11 : * sorties pour les liaisons. *
12 : * *
13 : * Parametres: *
14 : * *
15 : * e ITABL Table definissant les liaisons en sortie. *
16 : * e ITLIA Table definissant toutes les liaisons sur une base. *
17 : * e KTRAV Segment de travail qui va remplir MTRES dans DYNE15 *
18 : * es II Compteur *
19 : * s NLS Nombre de demandes de liaisons en sortie *
20 : * s NVAR Nombre maxi de variables internes de liaisons *
21 : * *
22 : * *
23 : * Auteur, date de cr{ation: *
24 : * *
25 : * d après Lionel VIVAN, le 2 octobre 1989. *
26 : * *
27 : *--------------------------------------------------------------------*
28 : -INC CCOPTIO
29 : -INC SMMODEL
30 : -INC SMCHAML
31 : *
32 : SEGMENT,MTRAV
33 : INTEGER ICHRE2(NBLS),MPOLA(NBLS),MNULA(NBLS)
34 : INTEGER MPOLB(NBLS),MNULB(NBLS)
35 : INTEGER IVLIAA(NBLS,NTVAR),INLIAA(NBLS,NTVAR)
36 : INTEGER IVLIAB(NBLS,NTVAR),INLIAB(NBLS,NTVAR)
37 : ENDSEGMENT
38 : *
39 : LOGICAL L0,L1,LVAR
40 : CHARACTER*8 MONMOT,TYPRET,CHARRE,CMATE
41 : CHARACTER*40 CMOT
42 : *
43 : CMOT=' '
44 : MTRAV = KTRAV
45 : NLS = 0
46 : NVAR = 0
47 : mmodel = itlia
48 :
49 : * table indicée par des entiers
49 : CALL DIMEN7 (ITABL,IDIMEN)
50 :
51 : mmodel = itlia
52 : segact mmodel
53 : mchelm = itcara
54 : segact mchelm
55 : segact mmodel
56 : *
57 : * recherche des liaisons en sortie : faire une table index de la tsortie.liaison
58 : *
59 : INDICE = 0
60 : IVAR = 0
61 : 100 CONTINUE
62 : INDICE = INDICE + 1
63 : TYPRET = ' '
63 : CALL ACCTAB(ITABL,'ENTIER',INDICE,X0,' ',L0,IP0,
64 : & TYPRET,I1,X1,CHARRE,L1,ITTL)
65 : IF (TYPRET.EQ.'MMODEL ' .AND. ITTL.NE.0) THEN
66 : TYPRET = ' '
66 : CALL ACCTAB(ITSORT,'MMODEL ',I0,X0,' ',L0,ITTL,
67 : & TYPRET,I1,X1,CHARRE,LVAR,ITVAR)
68 : mmode1 = ittl
69 : segact mmode1
70 : * on attend une liaison elementaire
71 : imode1 = mmode1.kmodel(1)
72 : segact imode1
73 : do ik = 1,kmodel(/1)
74 : imodel = kmodel(ik)
75 : segact imodel
76 : * write(6,*) imodel,imode1,conmod,imode1.conmod,imamod,imode1.imamod
77 : if (imode1.conmod.eq.conmod.or.imode1.imamod.eq.imamod) goto 110
78 : segdes imodel
79 : enddo
80 : segdes imode1,mmode1
81 : goto 100
82 :
83 : 110 continue
84 : *
85 : * toutes les variables de la liaison sont en sortie
86 : *
87 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR) THEN
88 : NLS = NLS + 1
89 : MNULA(NLS) = INDICE
90 : MPOLA(NLS) = ITTL
91 : CMATE = CMATEE
92 : lcham = 0
93 : MONMOT = ' '
94 : do im = 1,imache(/1)
95 : if(imache(im).eq.imamod.and.conche(im).eq.conmod) then
96 : mchaml = ichaml(im)
97 : lcham = mchaml
98 : segact mchaml
99 : do l=1,nomche(/2)
100 : if (nomche(l).eq.'AMOR') MONMOT='FLOTTANT'
101 : enddo
102 : segdes mchaml
103 : endif
104 : enddo
105 : *
106 :
107 : IF (CMATE.EQ.'PO_PL_FL') THEN
108 : IVAR = 6
109 : NVAR = MAX(NVAR,IVAR)
110 : II = II + 1
111 : ICHRE2(II) = IVAR
112 : IVLIAA(NLS,1) = 1
113 : INLIAA(NLS,1) = 7
114 : IVLIAA(NLS,2) = 1
115 : INLIAA(NLS,2) = 8
116 : IVLIAA(NLS,3) = 1
117 : INLIAA(NLS,3) = 69
118 : IVLIAA(NLS,4) = 1
119 : INLIAA(NLS,4) = 70
120 : IVLIAA(NLS,5) = 1
121 : INLIAA(NLS,5) = 71
122 : IVLIAA(NLS,6) = 1
123 : INLIAA(NLS,6) = 72
124 : *
125 : ELSE IF (CMOT(1:10).EQ.'PO_PL') THEN
126 : IF (MONMOT.EQ.'FLOTTANT') THEN
127 : IVAR = 3
128 : IVLIAA(NLS,3) = 1
129 : INLIAA(NLS,3) = 39
130 : ELSE
131 : IVAR = 2
132 : ENDIF
133 : NVAR = MAX(NVAR,IVAR)
134 : II = II + 1
135 : ICHRE2(II) = IVAR
136 : IVLIAA(NLS,1) = 1
137 : INLIAA(NLS,1) = 15
138 : IVLIAA(NLS,4) = 1
139 : INLIAA(NLS,4) = 7
140 : *
141 : ELSE IF (CMOT(1:16).EQ.'COUP_VIT') THEN
142 : IVAR = 3
143 : NVAR = MAX(NVAR,IVAR)
144 : II = II + 1
145 : ICHRE2(II) = IVAR
146 : IVLIAA(NLS,1) = 1
147 : INLIAA(NLS,1) = 73
148 : IVLIAA(NLS,3) = 1
149 : INLIAA(NLS,3) = 8
150 : IVLIAA(NLS,4) = 1
151 : INLIAA(NLS,4) = 7
152 : *
153 : ELSE IF (CMOT(1:20).EQ.'COUP_DEP') THEN
154 : IVAR = 2
155 : NVAR = MAX(NVAR,IVAR)
156 : II = II + 1
157 : ICHRE2(II) = IVAR
158 : IVLIAA(NLS,1) = 1
159 : INLIAA(NLS,1) = 74
160 : IVLIAA(NLS,4) = 1
161 : INLIAA(NLS,4) = 7
162 : *
163 : ELSE IF (CMOT(1:11).EQ.'POLYNOMI') THEN
164 : IVAR = 1
165 : NVAR = MAX(NVAR,IVAR)
166 : II = II + 1
167 : ICHRE2(II) = IVAR
168 : IVLIAA(NLS,1) = 1
169 : INLIAA(NLS,1) = 77
170 : *
171 : ELSE
171 : CALL ERREUR(490)
172 : RETURN
173 : ENDIF
174 : *
175 : ELSE IF (TYPRET.EQ.'TABLE ' .AND. ITVAR.NE.0) THEN
176 : * kich : on met toutes les variables
177 : if (.false.) then
178 : NLS = NLS + 1
179 : MNULA(NLS) = INDICE
180 : MPOLA(NLS) = ITTL
180 : CALL ACCTAB(ITTL,'MOT',I0,X0,'TYPE_LIAISON',L0,IP0,
181 : & 'MOT',I1,X1,CMOT,L1,IT1)
182 : IVAR = 0
183 : *
184 : IF (CMOT(1:17).EQ.'POINT_PLAN_FLUIDE') THEN
185 : TYPRET = ' '
185 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
186 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
187 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
188 : IVAR = IVAR + 1
189 : IVLIAA(NLS,1) = 1
190 : INLIAA(NLS,1) = 7
191 : ENDIF
192 : TYPRET = ' '
192 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'VITESSE',L0,IP0,
193 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
194 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
195 : IVAR = IVAR + 1
196 : IVLIAA(NLS,2) = 1
197 : INLIAA(NLS,2) = 8
198 : ENDIF
199 : TYPRET = ' '
199 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'MASSE_AJOUTEE',L0,IP0,
200 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
201 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
202 : IVAR = IVAR + 1
203 : IVLIAA(NLS,3) = 1
204 : INLIAA(NLS,3) = 69
205 : ENDIF
206 : TYPRET = ' '
206 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_CONVECTION',L0,IP0,
207 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
208 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
209 : IVAR = IVAR + 1
210 : IVLIAA(NLS,4) = 1
211 : INLIAA(NLS,4) = 70
212 : ENDIF
213 : TYPRET = ' '
213 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_VISCOSITE',L0,IP0,
214 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
215 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
216 : IVAR = IVAR + 1
217 : IVLIAA(NLS,5) = 1
218 : INLIAA(NLS,5) = 71
219 : ENDIF
220 : TYPRET = ' '
220 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_PERTE_DE_CHARGE',
221 : & L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IT1)
222 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
223 : IVAR = IVAR + 1
224 : IVLIAA(NLS,6) = 1
225 : INLIAA(NLS,6) = 72
226 : ENDIF
227 : IF (IVAR.EQ.0) THEN
227 : CALL ERREUR(496)
228 : RETURN
229 : ENDIF
230 : *
231 : ELSE IF (CMOT(1:10).EQ.'POINT_PLAN') THEN
232 : TYPRET = ' '
232 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
233 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
234 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
235 : IVAR = IVAR + 1
236 : IVLIAA(NLS,4) = 1
237 : INLIAA(NLS,4) = 7
238 : ENDIF
239 : TYPRET = ' '
239 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'VITESSE_NORMALE',L0,IP0,
240 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
241 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
242 : IVAR = IVAR + 1
243 : IVLIAA(NLS,3) = 1
244 : INLIAA(NLS,3) = 39
245 : ENDIF
246 : TYPRET = ' '
246 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_DE_CHOC',L0,IP0,
247 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
248 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
249 : IVAR = IVAR + 1
250 : IVLIAA(NLS,1) = 1
251 : INLIAA(NLS,1) = 15
252 : ENDIF
253 : IF (IVAR.EQ.0) THEN
253 : CALL ERREUR(496)
254 : RETURN
255 : ENDIF
256 : *
257 : ELSE IF (CMOT(1:16).EQ.'COUPLAGE_VITESSE') THEN
258 : TYPRET = ' '
258 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
259 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
260 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
261 : IVAR = IVAR + 1
262 : IVLIAA(NLS,4) = 1
263 : INLIAA(NLS,4) = 7
264 : ENDIF
265 : TYPRET = ' '
265 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'VITESSE',L0,IP0,
266 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
267 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
268 : IVAR = IVAR + 1
269 : IVLIAA(NLS,3) = 1
270 : INLIAA(NLS,3) = 8
271 : ENDIF
272 : TYPRET = ' '
272 : CALL ACCTAB(ITVAR,'MOT',I0,X0,
273 : & 'FORCE_DE_COUPLAGE_VITESSE',L0,IP0,
274 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
275 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
276 : IVAR = IVAR + 1
277 : IVLIAA(NLS,1) = 1
278 : INLIAA(NLS,1) = 73
279 : ENDIF
280 : IF (IVAR.EQ.0) THEN
280 : CALL ERREUR(496)
281 : RETURN
282 : ENDIF
283 : *
284 : ELSE IF (CMOT(1:20).EQ.'COUPLAGE_DEPLACEMENT') THEN
285 : TYPRET = ' '
285 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'DEPLACEMENT',L0,IP0,
286 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
287 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
288 : IVAR = IVAR + 1
289 : IVLIAA(NLS,4) = 1
290 : INLIAA(NLS,4) = 7
291 : ENDIF
292 : TYPRET = ' '
292 : CALL ACCTAB(ITVAR,'MOT',I0,X0,
293 : & 'FORCE_DE_COUPLAGE_DEPLACEMENT',L0,IP0,
294 : & TYPRET,I1,X1,CHARRE,LVAR,IT1)
295 : IF (TYPRET.EQ.'LOGIQUE ' .AND. LVAR ) THEN
296 : IVAR = IVAR + 1
297 : IVLIAA(NLS,1) = 1
298 : INLIAA(NLS,1) = 74
299 : ENDIF
300 : IF (IVAR.EQ.0) THEN
300 : CALL ERREUR(496)
301 : RETURN
302 : ENDIF
303 : *
304 : ELSE IF (CMOT(1:11).EQ.'POLYNOMIALE') THEN
305 : TYPRET = ' '
305 : CALL ACCTAB(ITVAR,'MOT',I0,X0,'FORCE_POLYNOMIALE',
306 : & L0,IP0,TYPRET,I1,X1,CHARRE,LVAR,IT1)
307 : IF (TYPRET.EQ.'LOGIQUE '.AND.LVAR) THEN
308 : IVAR = IVAR + 1
309 : IVLIAA(NLS,1) = 1
310 : INLIAA(NLS,1) = 77
311 : ENDIF
312 : *
313 : ELSE
313 : CALL ERREUR(490)
314 : RETURN
315 : ENDIF
316 : NVAR = MAX(NVAR,IVAR)
317 : II = II + 1
318 : ICHRE2(II) = IVAR
319 : IF (IIMPI.EQ.333) THEN
320 : WRITE(IOIMP,*)'DYNE24 : ICHRE2(',II,')=',IVAR
321 : ENDIF
322 : * kich annulation du choix
323 : endif
324 : ENDIF
325 : GOTO 100
326 : ELSE
327 : if (indice.le.idimen) goto 100
328 : ENDIF
329 : IF (IIMPI.EQ.333) THEN
330 : WRITE(IOIMP,*) 'DYNE24 : NVAR = ',NVAR
331 : WRITE(IOIMP,*) 'DYNE24 : NLS = ',NLS
332 : WRITE(IOIMP,*) 'DYNE24 : IVAR = ',IVAR
333 : ENDIF
334 : *
335 : END
336 :
337 :
338 :
339 :
340 :
341 :
342 :
© Cast3M 2003 - All rights reserved.
Disclaimer