1 : C PENTE1 SOURCE PV 09/03/12 21:29:56 6325
2 : SUBROUTINE PENTE1(ICEN,IFAC,IFACEL,INORM,IOP2,IOP3,IMCHAM,ICHPO,
3 : & ICHCL,ICHGRA,IMCALP)
4 : C
5 : C************************************************************************
6 : C
7 : C PROJET : CASTEM 2000
8 : C
9 : C NOM : PENTE1
10 : C
11 : C DESCRIPTION : Cette subroutine est appellée par la subroutine
12 : C PENT (calcul du gradient d'un CHPOINT 2D de type
13 : C CENTRE)
14 : C
15 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
16 : C
17 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
18 : C AUTEUR (Modif.) : R. MOREL, DRN/DMT/SEMT/TTMF
19 : C
20 : C************************************************************************
21 : C
22 : C
23 : C APPELES (Outils) : LICHT, KRIPAD, ERREUR
24 : C
25 : C APPELES (Calcul) : PENTE2, PENTE3
26 : C
27 : C
28 : C************************************************************************
29 : C
30 : C ENTREES : ICEN : pointeur de MELEME 'CENTRE'
31 : C
32 : C IFAC : pointeur de MELEME 'FACE'
33 : C
34 : C IFACEL : pointeur de MELEME 'FACEL'
35 : C
36 : C INORM : pointeur des CHPOINT de normales aux faces
37 : C
38 : C IOP2 : INTEGER:
39 : C 1 2
40 : C 'EULESCAL','EULEVECT'
41 : C
42 : C IOP2 = 1 -> symetrique d'un scalaire au bord
43 : C IOP2 = 2 -> symetrique d'un vecteur au bord
44 : C
45 : C IOP3 : INTEGER;
46 : C IOP3 = 1 -> no limiteur
47 : C IOP3 = 2 -> limiteur
48 : C
49 : C IMCHAM : pointeur d'un object de type MCHAML qui contient
50 : C les elements de matrice mijx, mijx
51 : C
52 : C ICHPO : CHPOINT 'CENTRE' dont on veut calcular le gradient
53 : C (NC composantes, NC < 9)
54 : C
55 : C ICHCL : CHPOINT de conditions limites (optionel)
56 : C
57 : C
58 : C SORTIES: ICHGRA : CHPOINT 'CENTRE' qui contient les gradients
59 : C (2 ou 3 * NC composantes)
60 : C Nom de le composantes:
61 : C 'P1DX', 'P1DY',('P1DZ'), 'P2DX', 'P2DY',('P2DZ')
62 : C
63 : C IMCALP : CHPOINT 'CENTRE' qui contient les limiteurs
64 : C (NC composantes)
65 : C Nom de le composantes:
66 : C 'P1', 'P2', ...
67 : C Dans le cas I0P3 = 1 -> IMCALP = 0
68 : C IOP3 = 3 -> Le composantes sont
69 : C eguals
70 : C
71 : C************************************************************************
72 : C
73 : C HISTORIQUE (Anomalies et modifications éventuelles)
74 : C
75 : C HISTORIQUE : Cree le 4-6-1998
76 : C
77 : C HISTORIQUE : Modifie pour adaptation 3D le 20-10-1998
78 : C Modifie pour reconstruction quadratique exacte
79 : C le 25-04-2000 (A. BECCANTINI)
80 : C
81 : C Modif 10.070.1: on calcule un limiteur egual à 1 dans
82 : C le cas 'NOLIMITE' (IOP3=1)
83 : C
84 : C
85 : C************************************************************************
86 : C
87 : C
88 : C**** Les includes
89 : C
90 : IMPLICIT INTEGER(I-N)
91 : -INC CCOPTIO
92 : -INC SMCOORD
93 : -INC SMCHPOI
94 : -INC SMCHAML
95 : -INC SMELEME
96 : -INC SMLENTI
97 : C
98 : POINTEUR MPOMAX.MPOVAL, MPOMIN.MPOVAL, MPOALP.MPOVAL,
99 : & MPOVCL.MPOVAL, MPOCHP.MPOVAL, MPOGRA.MPOVAL
100 : POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLEFAC.MLENTI
101 : POINTEUR MELEFL.MELEME
102 : C
103 : C**** Variables de COOPTIO
104 : C
105 : INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
106 : & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
107 : & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
108 : & ,IECHO, IIMPI, IOSPI
109 : & ,IDIM
110 : C & ,MCOORD
111 : & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
112 : & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
113 : & ,NORINC,NORVAL,NORIND,NORVAD
114 : & ,NUCROU, IPSAUV, IFICLE, IPREFI
115 : & ,ISAFOR, IREFOR
116 : C
117 : INTEGER ICEN, IFACEL, IOP2, IOP3, IMCHAM, ICHPO, ICHCL, ICHGRA
118 : & ,IMCALP, NCEN, NTOT,INORM, IFAC ,NCOMP, NC
119 : & ,N, I1, I2, NFAC, IGEOM, JG
120 : C
121 : LOGICAL LOGVEC
122 : CHARACTER*(4) NOMCOM(27),NOMMCH(9)
123 : CHARACTER*8 TYPE
124 : C
125 : DATA NOMCOM /'P1DX','P1DY','P1DZ',
126 : & 'P2DX','P2DY','P2DZ',
127 : & 'P3DX','P3DY','P3DZ',
128 : & 'P4DX','P4DY','P4DZ',
129 : & 'P5DX','P5DY','P5DZ',
130 : & 'P6DX','P6DY','P6DZ',
131 : & 'P7DX','P7DY','P7DZ',
132 : & 'P8DX','P8DY','P8DZ',
133 : & 'P9DX','P9DY','P9DZ'/
134 : DATA NOMMCH /'P1 ',
135 : & 'P2 ',
136 : & 'P3 ',
137 : & 'P4 ',
138 : & 'P5 ',
139 : & 'P6 ',
140 : & 'P7 ',
141 : & 'P8 ',
142 : & 'P9 '/
143 : C
144 : C**************************************
145 : C**** PARTIE DU CALCUL DU GRADIENT ****
146 : C**************************************
147 : C
148 : C
149 : C**** Nombre total de points
150 : C
151 : NTOT = MCOORD.XCOOR(/1)/(IDIM+1)
152 : C
153 : C**** Conditions limites
154 : C
155 : IF (ICHCL .GT. 0) THEN
156 : TYPE=' '
156 : CALL LICHT(ICHCL,MPOVCL,TYPE,IGEOM)
157 : C
158 : C******* En LICHT
159 : C SEGACT*MOD MPOVCL
160 : C
160 : CALL KRIPAD(IGEOM,MLENCL)
161 : C
162 : C******* En KRIPAD
163 : C SEGACT IGEOM, MLENCL
164 : C
165 : MELEME = IGEOM
166 : SEGDES MELEME
167 : ELSE
168 : JG = NTOT
169 : SEGINI MLENCL
170 : DO I1 = 1 , JG
171 : MLENCL.LECT(I1)=0
172 : ENDDO
173 : MPOVCL = -1
174 : ENDIF
175 : C
176 : C**** Le MELEME CENTRE (SPG du CHPOINT dont on veux calculer le gradient)
177 : C
177 : CALL KRIPAD(ICEN,MLECEN)
178 : C
179 : C**** En KRIPAD
180 : C SEGACT ICEN
181 : C SEGINI MLECEN
182 : C
183 : MELEME = ICEN
184 : NCEN = MELEME.NUM(/2)
185 : SEGDES MELEME
186 : C
187 : C**** Le MLENTI avec la numerotation global/local des points FACE
188 : C
188 : CALL KRIPAD(IFAC,MLEFAC)
189 : C
190 : C**** En KRIPAD
191 : C SEGACT IFAC
192 : C SEGINI MLEFAC
193 : C
194 : MELEME = IFAC
195 : SEGDES MELEME
196 : C
197 : C**** Si on traite un champ vectoriel avec l'option EULEVECT
198 : C Les composantes doivent etre 2 (3): 'UX' 'UY' ('UZ)
199 : C
200 : MCHPO1 = ICHPO
201 : SEGACT MCHPO1
202 : MSOUP1 = MCHPO1.IPCHP(1)
203 : SEGACT MSOUP1
204 : IF (IOP2.EQ.2) THEN
205 : NCOMP = MSOUP1.NOCOMP(/2)
206 : IF (IDIM.EQ.2) THEN
207 : LOGVEC=(MSOUP1.NOCOMP(1).EQ.'UX ').AND.
208 : & (MSOUP1.NOCOMP(2).EQ.'UY ').AND.
209 : & (NCOMP .EQ.2)
210 : ELSE
211 : LOGVEC=(MSOUP1.NOCOMP(1).EQ.'UX ').AND.
212 : & (MSOUP1.NOCOMP(2).EQ.'UY ').AND.
213 : & (MSOUP1.NOCOMP(3).EQ.'UZ ').AND.
214 : & (NCOMP .EQ. 3)
215 : ENDIF
216 : IF (.NOT.LOGVEC) THEN
217 : C
218 : C********** Message d'erreur standard
219 : C -301 0 %m1:40
220 : C
221 : MOTERR(1:40) = 'PENT EULEVECT '
222 : WRITE(IOIMP,*) MOTERR(1:40)
223 : C
224 : C********** Message d'erreur standard
225 : C 21 2
226 : C Données incompatibles
227 : C
227 : CALL ERREUR(21)
228 : GOTO 9999
229 : ENDIF
230 : ENDIF
231 : C
232 : C**** Le MPOVAL du CHPOINT
233 : C
234 : MPOCHP = MSOUP1.IPOVAL
235 : SEGACT MPOCHP
236 : SEGDES MCHPO1
237 : SEGDES MSOUP1
238 : NCOMP = MPOCHP.VPOCHA(/2)
239 : C
240 : C**** Le CHPOINT ICHGRA
241 : C
242 : SEGINI, MCHPO2 = MCHPO1
243 : MCHPO2.MOCHDE = 'Gradient '
244 : ICHGRA = MCHPO2
245 : C
246 : NC = IDIM * NCOMP
247 : SEGINI MSOUP2
248 : C
249 : C Nom de ses composantes
250 : C
251 : MCHPO2.IPCHP(1) = MSOUP2
252 : SEGDES MCHPO2
253 : C
254 : DO I1 = 1, NCOMP
255 : DO I2 = 1, IDIM
256 : MSOUP2.NOCOMP((I1-1)*IDIM+I2) = NOMCOM((I1-1)*3+I2)
257 : ENDDO
258 : ENDDO
259 : MSOUP2.IGEOC = ICEN
260 : C
261 : N = NCEN
262 : SEGINI MPOGRA
263 : MSOUP2.IPOVAL = MPOGRA
264 : SEGDES MSOUP2
265 : C
266 : C**** Les MPOVAL MPOMAX, MPOMIN, (maximum et minimum dans le stencil),
267 : C utilises pour le calcul du limiteur mais calcules dans PENTE2.
268 : C
269 : SEGINI, MPOMAX = MPOCHP
270 : SEGINI, MPOMIN = MPOCHP
271 : C
272 : C**** Segments déjà activés
273 : C
274 : C MPOVCL
275 : C MLENCL
276 : C MLECEN
277 : C MLEFAC
278 : C MPOCHP
279 : C MPOGRA
280 : C MPOMIN
281 : C MPOMAX
282 : C
282 : CALL PENTE2(IOP2,INORM,
283 : & MLECEN,MLEFAC,MLENCL,IMCHAM,
284 : & NCOMP,MPOCHP,MPOVCL,MPOGRA,
285 : & MPOMIN,MPOMAX)
286 : C
287 : IF(IERR .NE. 0)GOTO 9999
288 : C
289 : C
290 : C****************************
291 : C**** Calcul du limiteur ****
292 : C****************************
293 : C
294 : C
295 : C**** Limiteur
296 : C
297 : C
298 : C**** Le MPOVAL du limiteur
299 : C
300 : C MPOCHP = MPOVAL du CHPOINT dont on veux calculer le gradient
301 : C
302 : SEGINI, MPOALP = MPOCHP
303 : C
304 : C**** Le MSOUPO du limiteur
305 : C
306 : SEGINI, MSOUP2 = MSOUP1
307 : DO I1 = 1, NCOMP
308 : MSOUP2.NOCOMP(I1) = NOMMCH(I1)
309 : ENDDO
310 : MSOUP2.IPOVAL = MPOALP
311 : SEGDES MSOUP2
312 : C
313 : C*****Le MCHPOINT du limiteur
314 : C
315 : SEGINI, MCHPO2 = MCHPO1
316 : MCHPO2.MOCHDE = 'Limiteur du gradient '
317 : MCHPO2.IPCHP(1) = MSOUP2
318 : IMCALP = MCHPO2
319 : SEGDES MCHPO2
320 : C
321 : C******* Le MELEME FACEL
322 : C
323 : MELEFL = IFACEL
324 : SEGACT MELEFL
325 : NFAC = MELEFL.NUM(/2)
326 : C
327 : C********** Initialisation du limiteur a 1.0
328 : C
329 : DO I2 = 1, NCOMP
330 : DO I1 = 1, NCEN
331 : MPOALP.VPOCHA(I1,I2) = 1.0D0
332 : ENDDO
333 : ENDDO
334 : C
335 : IF(IOP3 .EQ. 2)THEN
336 : C
337 : C******* Calcul de limiteur Barth-Jespersen
338 : C
339 : C
340 : C******* Dans les cas quadrati, on est obligé de redefinir
341 : C MPOMAX et MPOMIN
342 : C
343 : IF(IOP2 .EQ. 5)THEN
344 : DO I2 = 1, NCOMP
345 : DO I1 = 1, NCEN
346 : MPOMIN.VPOCHA(I1,I2) = MPOCHP.VPOCHA(I1,I2)
347 : ENDDO
348 : ENDDO
348 : CALL PENTE5(NFAC,NCOMP,MELEFL,MPOCHP,MLECEN,MPOVCL,MLENCL,
349 : & MPOMIN,MPOMAX)
350 : ENDIF
350 : CALL PENTE3(NFAC,MELEFL,MLECEN,NCOMP,MPOCHP,
351 : & MPOGRA,MPOMIN,MPOMAX,MPOALP)
352 : IF(IERR .NE. 0)GOTO 9999
353 : SEGDES MELEFL
354 : SEGDES MPOALP
355 : ENDIF
356 : C
357 : C**** Desactivations et destruction de segments
358 : C
359 : SEGSUP MLECEN
360 : SEGSUP MLEFAC
361 : SEGSUP MLENCL
362 : SEGDES MPOCHP
363 : SEGDES MPOGRA
364 : IF (ICHCL .GT. 0)SEGDES MPOVCL
365 : SEGSUP MPOMAX
366 : SEGSUP MPOMIN
367 : C
368 : 9999 CONTINUE
369 : RETURN
370 : END
371 :
372 :
373 :
374 :
375 :
376 :
377 :
378 :
379 :
380 :
381 :
382 :
383 :
© Cast3M 2003 - All rights reserved.
Disclaimer