1 : C KONSF1 SOURCE PV 09/03/12 21:26:42 6325
2 : SUBROUTINE KONSF1(INDMET,ISF,IVN,INORM,ICHPSU,ICHPDI,
3 : & MELEMC,MELEMF,MELEFE,ICHFLU,DT,LOGAN,
4 : & MESERR)
5 : C************************************************************************
6 : C
7 : C PROJET : CASTEM 2000
8 : C
9 : C NOM : KONSF1
10 : C
11 : C DESCRIPTION : Voir KONV14
12 : C
13 : C Cas 2D/3D
14 : C
15 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
16 : C
17 : C AUTEUR : A. BECCANTINI, DM2S/SFME
18 : C
19 : C************************************************************************
20 : C
21 : C APPELES (Outils
22 : C CASTEM) : KRIPAD, LICHT
23 : C
24 : C APPELES (Calcul) :
25 : C
26 : C************************************************************************
27 : C
28 : C ENTREES
29 : C
30 : C 1) PARAMETRES
31 : C
32 : C INDMET : 1 UPWIND
33 : C
34 : C 2 CENTERED
35 : C
36 : C 2) Pointeurs des MCHAMLs/CHPOINTs
37 : C
38 : C ISF : MCHAML sur "FACEL" contenant les scalaires passifs
39 : C ("gauche" et "droite");
40 : C
41 : C IVN : CHPOINTs sur "FACE" (vitesse aux faces)
42 : C
43 : C 3) Pointeurs de CHPOINTs de la table DOMAINE
44 : C
45 : C INORM : CHPOINT "FACE" contenant les normales aux faces
46 : C
47 : C ICHPSU : CHPOINT "FACE" contenant la surface des faces
48 : C
49 : C ICHPDI : CHPOINT "CENTRE" contenant le diametre minimum
50 : C de chaque element
51 : C
52 : C
53 : C 4) Pointeurs de MELEME de la table DOMAINE
54 : C
55 : C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
56 : C
57 : C MELEMF : MELEME 'FACE' du SPG des FACES
58 : C
59 : C MELEFE : MELEME 'FACEL' du connectivité FACES -> ELEM
60 : C
61 : C SORTIES
62 : C
63 : C ICHFLU : pointeurs de CHPOINTs "FACE" des flux aux interfaces:
64 : C
65 : C DT : pas de temps pour le respect de la CFL-like condition
66 : C DT < DIAMMIN /2 /max(Lambda_i)
67 : C En maillage regulier cette condition garantie la
68 : C non-interaction des ondes
69 : C
70 : C LOGAN : (LOGICAL): si .TRUE. une anomalie à été detectée
71 : C
72 : C MESERR : pour l'ecriture des messages d'erreurs
73 : C
74 : C************************************************************************
75 : C
76 : C HISTORIQUE (Anomalies et modifications éventuelles)
77 : C
78 : C HISTORIQUE : créée le 29.11.01
79 : C
80 : C************************************************************************
81 : C
82 : C
83 : C**** Variables de COOPTIO
84 : C
85 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
86 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
87 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
88 : C & ,IECHO, IIMPI, IOSPI
89 : C & ,IDIM
90 : C & ,MCOORD
91 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
92 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
93 : C & ,NORINC,NORVAL,NORIND,NORVAD
94 : C & ,NUCROU, IPSAUV
95 : C
96 : IMPLICIT INTEGER(I-N)
97 : INTEGER INDMET, ISF, IVN, INORM
98 : & ,ICHPSU,ICHPDI,MELEMC,MELEMF,MELEFE
99 : & ,IGEOMC,IGEOMF
100 : & ,ICHFLU
101 : & ,NFAC
102 : & ,NLCF, NGCEG, NGCED, NLCEG, NLCED
103 : & ,NGCF, NLCF1, NSCA, ISCA
104 : REAL*8 DT, UNSDT, UX, UY, UZ, UN
105 : & , SURF,CNX, CNY, CNZ
106 : & , CELL, DIAM
107 : LOGICAL LOGAN
108 : CHARACTER*(40) MESERR
109 : CHARACTER*(8) TYPE
110 : C
111 : C**** LES INCLUDES
112 : C
113 : -INC CCOPTIO
114 : -INC SMCHAML
115 : -INC SMCHPOI
116 : POINTEUR MPOVSU.MPOVAL, MPOVDI.MPOVAL
117 : & , MPOFLU.MPOVAL, MPNORM.MPOVAL, MPOVIT.MPOVAL
118 : -INC SMELEME
119 : -INC SMLMOTS
120 : -INC SMLENTI
121 : C
122 : C**** Les flux aux interface dans le repaire (n,t)
123 : C
124 : INTEGER NFLU
125 : SEGMENT IFLUX
126 : REAL*8 FLUX(NFLU)
127 : ENDSEGMENT
128 : C
129 : C**** Scalaires
130 : C
131 : MCHEL1 = ISF
132 : SEGACT MCHEL1
133 : MCHAM1 = MCHEL1.ICHAML(1)
134 : SEGDES MCHEL1
135 : SEGACT MCHAM1
136 : NSCA= MCHAM1.IELVAL(/1)
137 : DO ISCA=1,NSCA,1
138 : MELVAL=MCHAM1.IELVAL(ISCA)
139 : SEGACT MELVAL
140 : ENDDO
141 : C
142 : C**** La vitesse
143 : C
143 : CALL LICHT(IVN,MPOVIT,TYPE,IGEOMC)
144 : IF(IERR.NE.0)GOTO 9999
145 : C SEGACT MPOVIT
146 : C
147 : C**** Le flux à l'interface
148 : C
149 : NFLU=NSCA
150 : SEGINI IFLUX
151 : C
152 : C**** Lecture des MELEMEs
153 : C
154 : C 'CENTRE', 'FACEL'
155 : C
156 : IPT2 = MELEFE
157 : SEGACT IPT2
158 : NFAC = IPT2.NUM(/2)
159 : C
160 : C**** KRIPAD pour la correspondance global/local de centre
161 : C
161 : CALL KRIPAD(MELEMC,MLENT1)
162 : IF(IERR.NE.0)GOTO 9999
163 : C
164 : C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
165 : C
166 : C Si i est le numero global d'un noeud de ICEN,
167 : C MLENT1.LECT(i) contient sa position, i.e.
168 : C
169 : C I = numero global du noeud centre
170 : C MLENT1.LECT(i) = numero local du noeud centre
171 : C
172 : C MLENT1 déjà activé, i.e.
173 : C
174 : C SEGACT MLENT1
175 : C
176 : C
177 : C**** KRIPAD pour la correspondance global/local de 'FACE'
178 : C
178 : CALL KRIPAD(MELEMF,MLENT2)
179 : IF(IERR.NE.0)GOTO 9999
180 : C SEGACT MELNT2
181 : C
182 : C**** CHPOINTs de la table DOMAINE
183 : C
183 : CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
184 : IF(IERR.NE.0)GOTO 9999
184 : CALL LICHT(ICHPDI,MPOVDI,TYPE,IGEOMC)
185 : IF(IERR.NE.0)GOTO 9999
185 : CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
186 : IF(IERR.NE.0)GOTO 9999
187 : C
188 : C**** LICHT active les MPOVALs en *MOD
189 : C
190 : C i.e.
191 : C
192 : C SEGACT MPOVSU*MOD
193 : C SEGACT MPOVDI*MOD
194 : C SEGACT MPNORM*MOD
195 : C
196 : C**** Les FLUX aux faces
197 : C
197 : CALL LICHT(ICHFLU,MPOFLU,TYPE,IGEOMF)
198 : C
199 : C SEGACT MPOFLU*MOD
200 : C
201 : C
202 : C**** Initialisation de 1/DT
203 : C
204 : UNSDT = 0.0D0
205 : C
206 : C**** BOUCLE SUR FACEL pour le calcul du FLUX
207 : C
208 : DO NLCF = 1, NFAC
209 : C
210 : C******* NLCF = numero local du centre de facel
211 : C NGCF = numero global du centre de facel
212 : C NLCF1 = numero local du centre de face
213 : C NGCEG = numero global du centre ELT "gauche"
214 : C NLCEG = numero local du centre ELT "gauche"
215 : C NGCED = numero global du centre ELT "droite"
216 : C NLCED = numero local du centre ELT "droite"
217 : C
218 : NGCEG = IPT2.NUM(1,NLCF)
219 : NGCED = IPT2.NUM(3,NLCF)
220 : NGCF = IPT2.NUM(2,NLCF)
221 : NLCF1 = MLENT2.LECT(NGCF)
222 : NLCEG = MLENT1.LECT(NGCEG)
223 : NLCED = MLENT1.LECT(NGCED)
224 : C
225 : C******* NLCF != NLCF1 -> l'auteur (MOI) n'a rien compris.
226 : C
227 : IF(NLCF .NE. NLCF1)THEN
228 : MESERR = 'Il ne faut pas jouer avec la console. '
229 : LOGAN = .TRUE.
230 : GOTO 9999
231 : ENDIF
232 : C
233 : C******* Calcul du flux/DT
234 : C
235 : UX=MPOVIT.VPOCHA(NLCF,1)
236 : UY=MPOVIT.VPOCHA(NLCF,2)
237 : CNX=MPNORM.VPOCHA(NLCF,1)
238 : CNY=MPNORM.VPOCHA(NLCF,2)
239 : UN= (UX*CNX) + (UY*CNY)
240 : IF(IDIM .EQ.3)THEN
241 : UZ=MPOVIT.VPOCHA(NLCF,3)
242 : CNZ=MPNORM.VPOCHA(NLCF,3)
243 : UN=UN+(UZ*CNZ)
244 : ENDIF
245 : C
246 : IF(INDMET .EQ. 1)THEN
247 : IF(UN.GT.0.0D0)THEN
248 : DO ISCA=1,NSCA,1
249 : MELVAL=MCHAM1.IELVAL(ISCA)
250 : IFLUX.FLUX(ISCA)=UN*MELVAL.VELCHE(1,NLCF)
251 : DIAM = MPOVDI.VPOCHA(NLCEG,1)
252 : ENDDO
253 : ELSE
254 : DO ISCA=1,NSCA,1
255 : MELVAL=MCHAM1.IELVAL(ISCA)
256 : IFLUX.FLUX(ISCA)=UN*MELVAL.VELCHE(3,NLCF)
257 : DIAM = MPOVDI.VPOCHA(NLCED,1)
258 : ENDDO
259 : ENDIF
260 : ELSEIF(INDMET .EQ. 2)THEN
261 : DO ISCA=1,NSCA,1
262 : MELVAL=MCHAM1.IELVAL(ISCA)
263 : IFLUX.FLUX(ISCA)=UN*(MELVAL.VELCHE(1,NLCF)+MELVAL
264 : $ .VELCHE(3,NLCF))*0.5D0
265 : DIAM = MIN(MPOVDI.VPOCHA(NLCED,1),MPOVDI.VPOCHA(NLCEG,1))
266 : ENDDO
267 : ENDIF
268 : C
269 : C******* Ecriture des flux
270 : C
271 : SURF = MPOVSU.VPOCHA(NLCF,1)
272 : DO ISCA=1,NSCA,1
273 : MPOFLU.VPOCHA(NLCF,ISCA) =
274 : & (IFLUX.FLUX(ISCA) * SURF )
275 : ENDDO
276 : C
277 : C******* Calcul du pas du temps (CFL)
278 : C
279 : CELL = ABS(UN)/DIAM
280 : IF(CELL .GT. UNSDT)THEN
281 : UNSDT = CELL
282 : ENDIF
283 : C
284 : C**** Fin boucle sur FACEL
285 : C
286 : ENDDO
287 : C
288 : C**** Pas du temps (condition de non interaction en 1D)
289 : C
290 : DT = 0.5D0 / UNSDT
291 : C
292 : C**** Desactivation des segments et
293 : C on detruit les MCHAMLs
294 : C
295 : SEGSUP MLENT1
296 : SEGSUP MLENT2
297 : SEGDES IPT2
298 : C
299 : SEGSUP IFLUX
300 : C
301 : SEGDES MPOVSU
302 : SEGDES MPOVDI
303 : SEGDES MPNORM
304 : C
305 : SEGDES MPOFLU
306 : C
307 : DO ISCA=1,NSCA,1
308 : MELVAL=MCHAM1.IELVAL(ISCA)
309 : SEGDES MELVAL
310 : ENDDO
311 : SEGDES MCHAM1
312 : C
313 : 9999 CONTINUE
314 : C
315 : RETURN
316 : END
317 : C
318 :
319 :
320 :
321 :
322 :
323 :
324 :
325 :
326 :
327 :
328 :
329 :
© Cast3M 2003 - All rights reserved.
Disclaimer