1 : C XLAP1E SOURCE MAGN 09/07/30 21:21:25 6458
2 : SUBROUTINE XLAP1E(ICOGRV,MPGRVF,MPROC,MPVITC,
3 : $ MPVOLU,MPNORM,MPSURF,MELEFL,
4 : $ KRFACE,KRCENT,
5 : $ LCLIMV,KRVIMP,MPVIMP,
6 : $ LCLITO,KRTOIM,
7 : $ NOMINC,
8 : $ MPMUC,
9 : $ IJACO,
10 : $ IMPR,IRET)
11 : IMPLICIT INTEGER(I-N)
12 : IMPLICIT REAL*8 (A-H,O-Z)
13 : C***********************************************************************
14 : C NOM : XLAP1E
15 : C DESCRIPTION : Calcul de la matrice jacobienne du résidu du laplacien
16 : C VF 2D.
17 : C Ici, on ne calcule que des contributions 'compliquées' à
18 : C la matrice jacobienne faisant intervenir les
19 : C coefficients pour le calcul des gradients de vitesse
20 : C (ICOGRV)
21 : C (contributions à (d Res_{\rho e_t} / d var)
22 : C var prenant successivement les valeurs :
23 : C \rho, \rho u, \rho v, \rho e_t )
24 : C Les contributions sont plus "compliquées" à calculer que
25 : C les simples (cf. xlap1c) car on a à dériver des produits
26 : C de fonctions de la vitesse.
27 : C xlap1d calcule aussi une partie des contributions
28 : C 'compliquées'.
29 : C
30 : C NOTE PERSO : On pourrait programmer ça plus lisiblement en stockant
31 : C les contributions dans un tableau de pointeurs (2
32 : C indices, c'est possible ?) et en effectuant des produits
33 : C matriciels (coeff. x matrices de dérivées).
34 : C On n'y coupera pas si on veut regrouper 2D et 3D...
35 : C On ne va pas le faire.
36 : C
37 : C LANGAGE : ESOPE
38 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
39 : C mél : gounand@semt2.smts.cea.fr
40 : C***********************************************************************
41 : C APPELES (UTIL) : AJMTK : ajoute un objet de type MATSIM (non
42 : C standard) à un objet de type MATRIK.
43 : C APPELE PAR : XLAP1A : Calcul de la matrice jacobienne du
44 : C résidu du laplacien VF 2D.
45 : C***********************************************************************
46 : C ENTREES : ICOGRV (type MCHELM) : coefficients pour le
47 : C calcul du gradient de la vitesse aux
48 : C interfaces.
49 : C MPGRVF (type MPOVAL) : gradient de la vitesse
50 : C aux interfaces.
51 : C MPROC (type MPOVAL) : masse volumique par
52 : C élément.
53 : C MPVITC (type MPOVAL) : vitesse par élément.
54 : C MPVOLU (type MPOVAL) : volume des éléments.
55 : C MPNORM (type MPOVAL) : normale aux faces.
56 : C MPSURF (type MPOVAL) : surface des faces.
57 : C MELEFL (type MELEME) : connectivités face-(centre
58 : C gauche, centre droit).
59 : C KRFACE (type MLENTI) : tableau de repérage dans
60 : C le maillage des faces des éléments.
61 : C KRCENT (type MLENTI) : tableau de repérage dans
62 : C le maillage des centres des éléments.
63 : C LCLIMV (type logique) : .TRUE. => CL de Dirichlet
64 : C sur la vitesse.
65 : C KRVIMP (type MLENTI) : tableau de repérage dans
66 : C maillage des CL de Dirichlet sur la
67 : C vitesse.
68 : C MPVIMP (type MPOVAL) : valeurs des CL de
69 : C Dirichlet sur la vitesse.
70 : C LCLITO (type logique) : .TRUE. => CL de Dirichlet
71 : C sur le tenseur des contraintes.
72 : C KRTOIM (type MLENTI) : tableau de repérage dans
73 : C maillage des CL de Dirichlet sur le tenseur des
74 : C contraintes
75 : C NOMINC (type MLMOTS) : noms des inconnues.
76 : C MPMUC (type MPOVAL) : viscosité dynamique (SI).
77 : C ENTREES/SORTIES : IJACO (type MATRIK) : matrice jacobienne du
78 : C résidu du laplacien VF 2D.
79 : C SORTIES : -
80 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
81 : C***********************************************************************
82 : C VERSION : v1, 12/10/2001, version initiale
83 : C HISTORIQUE : v1, 12/10/2001, création
84 : C HISTORIQUE :
85 : C HISTORIQUE :
86 : C***********************************************************************
87 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
88 : C en cas de modification de ce sous-programme afin de faciliter
89 : C la maintenance !
90 : C***********************************************************************
91 : -INC CCOPTIO
92 : -INC SMCOORD
93 : -INC SMCHPOI
94 : POINTEUR MPGRVF.MPOVAL
95 : POINTEUR MPMUC.MPOVAL
96 : POINTEUR MPROC.MPOVAL ,MPVITC.MPOVAL
97 : POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL
98 : POINTEUR MPVIMP.MPOVAL
99 : -INC SMCHAML
100 : POINTEUR ICOGRV.MCHELM,JCOGRV.MCHAML
101 : POINTEUR KDUNDX.MELVAL,KDUNDY.MELVAL
102 : -INC SMELEME
103 : POINTEUR MELEFL.MELEME
104 : POINTEUR MCOGRV.MELEME
105 : -INC SMLENTI
106 : POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI
107 : POINTEUR KRCENT.MLENTI,KRFACE.MLENTI
108 : -INC SMLMOTS
109 : POINTEUR NOMINC.MLMOTS
110 : -INC SMMATRIK
111 : POINTEUR IJACO.MATRIK
112 : *
113 : * Objet matrice élémentaire simplifié
114 : *
115 : SEGMENT GMATSI
116 : INTEGER POIPR1(NPP1,NEL1)
117 : INTEGER POIDU1(1,NEL1)
118 : INTEGER POIPR2(NPP2,NEL2)
119 : INTEGER POIDU2(2,NEL2)
120 : POINTEUR LMATSI(0).MATSIM
121 : ENDSEGMENT
122 : * Contributions compliquées 1 de la part du gradient de
123 : * vitesse (CCGRV1)
124 : POINTEUR CCGRV1.GMATSI
125 : SEGMENT MATSIM
126 : CHARACTER*8 NOMPRI,NOMDUA
127 : REAL*8 VALMA1(1,NPP1,NEL1)
128 : REAL*8 VALMA2(2,NPP2,NEL2)
129 : ENDSEGMENT
130 : POINTEUR RETRHO.MATSIM
131 : POINTEUR RETROU.MATSIM
132 : POINTEUR RETROV.MATSIM
133 : *
134 : REAL*8 MU
135 : *
136 : INTEGER IMPR,IRET
137 : *
138 : LOGICAL LCLIMV,LCLITO
139 : LOGICAL LMUR
140 : LOGICAL LCTR1A,LCTR1B
141 : *
142 : INTEGER IELEM,IPD,IPP,ISOUCH,IEL1,IEL2
143 : INTEGER NELEM,NPD,NPP,NSOUCH,NEL1,NEL2,NPP1,NPP2
144 : INTEGER NGCDRO,NGCGAU,NGFACE,NPPRIM,NPDUAL
145 : INTEGER NLCENP,NLCEND,NLFACE,NLCLTO,NLCLV
146 : INTEGER NLCED,NLCEG,NLFVI
147 : INTEGER NPTEL
148 : INTEGER ICOORX,NLCGAU,NLCDRO
149 : *
150 : REAL*8 ALPHA,UMALPH
151 : REAL*8 DRD,DRG
152 : REAL*8 DUXXF,DUXYF,DUYXF,DUYYF
153 : REAL*8 UXD,UXF,UXG,UYD,UYF,UYG
154 : REAL*8 XD,XF,XG,XFMXD,XFMXG
155 : REAL*8 YD,YF,YG,YFMYD,YFMYG
156 : REAL*8 ALPHAX,ALPHAY,CNX,CNY
157 : REAL*8 SIGNOR,SURFFA,VOLUEL
158 : REAL*8 RHOP,UP,VP
159 : REAL*8 FACTOR,FACTDU,FACTDV
160 : REAL*8 DUDRHO,DUDROU,DVDRHO,DVDROV
161 : *
162 : * Executable statements
163 : *
164 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans xlap1e.eso'
165 : * On calcule les contributions à (d Res_{\rho e_t} / d var) ; var
166 : * prenant successivement les valeurs :
167 : * \rho, \rho u, \rho v, \rho e_t
168 : * On dérive les termes : (\tens{\tau(\grad{u})} \prod \vect{u})
169 : * \pscal \vect{n}
170 : * ce qui donne deux contributions.
171 : * Contribution 1 :
172 : * ( (d \tens{\tau} / d var) \prod \vect{u}) \pscal \vect{n}
173 : * Contribution 2 :
174 : * ( \tens{\tau} \prod (d \vect{u} / d var)) \pscal \vect{n}
175 : * Note :
176 : * pas de contribution à (d Res_{\rho e_t} / d \rho e_t).
177 : * Les noms de matrices élémentaires (type MATSIM) associées sont :
178 : * RETRHO, RETROU, RETROV
179 : IF (LCLIMV) THEN
180 : SEGACT KRVIMP
181 : SEGACT MPVIMP
182 : ENDIF
183 : IF (LCLITO) THEN
184 : SEGACT KRTOIM
185 : ENDIF
186 : SEGACT NOMINC
187 : SEGACT KRCENT
188 : SEGACT KRFACE
189 : SEGACT MELEFL
190 : SEGACT MPSURF
191 : SEGACT MPNORM
192 : SEGACT MPVOLU
193 : SEGACT MPMUC
194 : SEGACT MPROC
195 : SEGACT MPVITC
196 : SEGACT MPGRVF
197 : SEGACT ICOGRV
198 : NSOUCH=ICOGRV.IMACHE(/1)
199 : DO 1 ISOUCH=1,NSOUCH
200 : MCOGRV=ICOGRV.IMACHE(ISOUCH)
201 : JCOGRV=ICOGRV.ICHAML(ISOUCH)
202 : SEGACT JCOGRV
203 : KDUNDX=JCOGRV.IELVAL(1)
204 : KDUNDY=JCOGRV.IELVAL(2)
205 : SEGDES JCOGRV
206 : SEGACT KDUNDX
207 : SEGACT KDUNDY
208 : SEGACT MCOGRV
209 : NELEM=MCOGRV.NUM(/2)
210 : NPTEL=MCOGRV.NUM(/1)
211 : NPP1=NPTEL-1
212 : NPP2=NPTEL-1
213 : NEL1=NELEM
214 : NEL2=NELEM
215 : IEL1=1
216 : IEL2=1
217 : SEGINI RETRHO
218 : SEGINI RETROU
219 : SEGINI RETROV
220 : SEGINI CCGRV1
221 : RETRHO.NOMPRI(1:4)=NOMINC.MOTS(1)
222 : RETRHO.NOMPRI(5:8)=' '
223 : RETRHO.NOMDUA(1:4)=NOMINC.MOTS(4)
224 : RETRHO.NOMDUA(5:8)=' '
225 : RETROU.NOMPRI(1:4)=NOMINC.MOTS(2)
226 : RETROU.NOMPRI(5:8)=' '
227 : RETROU.NOMDUA(1:4)=NOMINC.MOTS(4)
228 : RETROU.NOMDUA(5:8)=' '
229 : RETROV.NOMPRI(1:4)=NOMINC.MOTS(3)
230 : RETROV.NOMPRI(5:8)=' '
231 : RETROV.NOMDUA(1:4)=NOMINC.MOTS(4)
232 : RETROV.NOMDUA(5:8)=' '
233 : DO 12 IELEM=1,NELEM
234 : * Le premier point du support de ICOGRV est un point FACE
235 : NGFACE=MCOGRV.NUM(1,IELEM)
236 : NLFACE=KRFACE.LECT(NGFACE)
237 : IF (NLFACE.EQ.0) THEN
238 : WRITE(IOIMP,*) 'Erreur de programmation n°1'
239 : GOTO 9999
240 : ENDIF
241 : * On calcule la contribution 1 à la matrice jacobienne IJACO de la
242 : * face NGFACE
243 : * (points duaux : centres à gauche et à droite de la face)
244 : * (points primaux : une partie (bicoz conditions aux limites)
245 : * de ceux du stencil pour le calcul du gradient
246 : * à la face, ils doivent être des points centres)
247 : * Si le tenseur des contraintes sur la face est imposé par les
248 : * conditions aux limites, la contribution 1 de la face à IJACO est
249 : * nulle.
250 : LCTR1A=.TRUE.
251 : IF (LCLITO) THEN
252 : NLCLTO=KRTOIM.LECT(NGFACE)
253 : IF (NLCLTO.NE.0) THEN
254 : LCTR1A=.FALSE.
255 : ENDIF
256 : ENDIF
257 : IF (LCTR1A) THEN
258 : NGCGAU=MELEFL.NUM(1,NLFACE)
259 : NGCDRO=MELEFL.NUM(3,NLFACE)
260 : NLCGAU=KRCENT.LECT(NGCGAU)
261 : NLCDRO=KRCENT.LECT(NGCDRO)
262 : LMUR=(NGCGAU.EQ.NGCDRO)
263 : * On distingue le cas où la face est un bord du maillage (mur)
264 : * du cas où la face est interne au maillage
265 : IF (.NOT.LMUR) THEN
266 : ICOORX = ((IDIM + 1) * (NGFACE - 1))+1
267 : XF = MCOORD.XCOOR(ICOORX)
268 : YF = MCOORD.XCOOR(ICOORX+1)
269 : ICOORX = ((IDIM + 1) * (NGCGAU - 1))+1
270 : XG = MCOORD.XCOOR(ICOORX)
271 : YG = MCOORD.XCOOR(ICOORX+1)
272 : XFMXG = XF - XG
273 : YFMYG = YF - YG
274 : DRG=SQRT((XFMXG*XFMXG)+(YFMYG*YFMYG))
275 : ICOORX = ((IDIM + 1) * (NGCDRO - 1))+1
276 : XD = MCOORD.XCOOR(ICOORX)
277 : YD = MCOORD.XCOOR(ICOORX+1)
278 : XFMXD = XF - XD
279 : YFMYD = YF - YD
280 : DRD=SQRT((XFMXD*XFMXD)+(YFMYD*YFMYD))
281 : ALPHA=DRG/(DRG+DRD)
282 : UMALPH= 1.0D0 - ALPHA
283 : ELSE
284 : ALPHA=0.0D0
285 : UMALPH=1.0D0
286 : ENDIF
287 : MU=UMALPH*MPMUC.VPOCHA(NLCGAU,1) +
288 : & ALPHA*MPMUC.VPOCHA(NLCDRO,1)
289 : * On calcule tout d'abord une interpolation de la vitesse sur la
290 : * face NGFACE de la même manière que dans xlap12.eso.
291 : IF (LCLIMV) THEN
292 : NLFVI=KRVIMP.LECT(NGFACE)
293 : ELSE
294 : NLFVI=0
295 : ENDIF
296 : * La vitesse est imposée sur la face, rien à calculer
297 : IF (NLFVI.NE.0) THEN
298 : UXF=MPVIMP.VPOCHA(NLFVI,1)
299 : UYF=MPVIMP.VPOCHA(NLFVI,2)
300 : ELSE
301 : NLCEG=KRCENT.LECT(NGCGAU)
302 : NLCED=KRCENT.LECT(NGCDRO)
303 : * Cas non au bord
304 : IF (.NOT.LMUR) THEN
305 : * Paramètres géométriques
306 : ICOORX = ((IDIM + 1) * (NGFACE - 1))+1
307 : XF = MCOORD.XCOOR(ICOORX)
308 : YF = MCOORD.XCOOR(ICOORX+1)
309 : ICOORX = ((IDIM + 1) * (NGCGAU - 1))+1
310 : XG = MCOORD.XCOOR(ICOORX)
311 : YG = MCOORD.XCOOR(ICOORX+1)
312 : XFMXG = XF - XG
313 : YFMYG = YF - YG
314 : DRG=SQRT((XFMXG*XFMXG)+(YFMYG*YFMYG))
315 : ICOORX = ((IDIM + 1) * (NGCDRO - 1))+1
316 : XD = MCOORD.XCOOR(ICOORX)
317 : YD = MCOORD.XCOOR(ICOORX+1)
318 : XFMXD = XF - XD
319 : YFMYD = YF - YD
320 : DRD=SQRT((XFMXD*XFMXD)+(YFMYD*YFMYD))
321 : ALPHA=DRG/(DRG+DRD)
322 : UMALPH= 1.0D0 - ALPHA
323 : DUXXF = MPGRVF.VPOCHA(NLFACE,1)
324 : DUXYF = MPGRVF.VPOCHA(NLFACE,2)
325 : DUYXF = MPGRVF.VPOCHA(NLFACE,3)
326 : DUYYF = MPGRVF.VPOCHA(NLFACE,4)
327 : * Calcul de la vitesse
328 : UXG = MPVITC.VPOCHA(NLCEG,1)
329 : UYG = MPVITC.VPOCHA(NLCEG,2)
330 : UXD = MPVITC.VPOCHA(NLCED,1)
331 : UYD = MPVITC.VPOCHA(NLCED,2)
332 : UXF = UMALPH * UXG + ALPHA * UXD
333 : UYF = UMALPH * UYG + ALPHA * UYD
334 : * Correction de la vitesse lineaire exacte
335 : UXF = UXF +
336 : $ (DUXXF * ((XFMXG * UMALPH)+ (XFMXD * ALPHA)))
337 : $ +(DUXYF * ((YFMYG * UMALPH)+ (YFMYD * ALPHA)))
338 : UYF = UYF +
339 : $ (DUYXF * ((XFMXG * UMALPH)+ (XFMXD * ALPHA)))
340 : $ +(DUYYF * ((YFMYG * UMALPH)+ (YFMYD * ALPHA)))
341 :
342 : * Cas au bord
343 : ELSE
344 : * Parametres geometriques
345 : ICOORX = ((IDIM + 1) * (NGFACE - 1))+1
346 : XF = MCOORD.XCOOR(ICOORX)
347 : YF = MCOORD.XCOOR(ICOORX+1)
348 : ICOORX = ((IDIM + 1) * (NGCGAU - 1))+1
349 : XG = MCOORD.XCOOR(ICOORX)
350 : YG = MCOORD.XCOOR(ICOORX+1)
351 : XFMXG = XF - XG
352 : YFMYG = YF - YG
353 : DUXXF = MPGRVF.VPOCHA(NLFACE,1)
354 : DUXYF = MPGRVF.VPOCHA(NLFACE,2)
355 : DUYXF = MPGRVF.VPOCHA(NLFACE,3)
356 : DUYYF = MPGRVF.VPOCHA(NLFACE,4)
357 : * Calcul de la vitesse
358 : UXF = MPVITC.VPOCHA(NLCEG,1)
359 : UYF = MPVITC.VPOCHA(NLCEG,2)
360 : * Correction de la vitesse lineaire exacte
361 : UXF = UXF + (DUXXF * XFMXG ) + (DUXYF * YFMYG )
362 : UYF = UYF + (DUYXF * XFMXG ) + (DUYYF * YFMYG )
363 : ENDIF
364 : ENDIF
365 : * On distingue le cas où la face est un bord du maillage (mur)
366 : * du cas où la face est interne au maillage
367 : IF (.NOT.LMUR) THEN
368 : NPD=2
369 : ELSE
370 : NPD=1
371 : ENDIF
372 : NPP=NPTEL-1
373 : * IPD=1 : point à gauche du point NGFACE
374 : * IPD=2 : point à droite du point NGFACE
375 : DO 122 IPD=1,NPD
376 : NPDUAL=MELEFL.NUM((2*IPD)-1,NLFACE)
377 : IF (.NOT.LMUR) THEN
378 : CCGRV1.POIDU2(IPD,IEL2)=NPDUAL
379 : ELSE
380 : CCGRV1.POIDU1(IPD,IEL1)=NPDUAL
381 : ENDIF
382 : NLCEND=KRCENT.LECT(NPDUAL)
383 : IF (NLCEND.EQ.0) THEN
384 : WRITE(IOIMP,*) 'Erreur grave n°1'
385 : GOTO 9999
386 : ENDIF
387 : DO 124 IPP=1,NPP
388 : NPPRIM=MCOGRV.NUM(IPP+1,IELEM)
389 : LCTR1B=.TRUE.
390 : IF (LCLIMV) THEN
391 : NLCLV=KRVIMP.LECT(NPPRIM)
392 : IF (NLCLV.NE.0) THEN
393 : LCTR1B=.FALSE.
394 : ENDIF
395 : ENDIF
396 : IF (.NOT.LCTR1B) THEN
397 : * Lorsque une contribution est nulle, on fixe artificiellement le
398 : * point primal égal au point dual.
399 : IF (.NOT.LMUR) THEN
400 : CCGRV1.POIPR2(IPP,IEL2)=NPDUAL
401 : RETRHO.VALMA2(IPD,IPP,IEL2)=0.D0
402 : RETROU.VALMA2(IPD,IPP,IEL2)=0.D0
403 : RETROV.VALMA2(IPD,IPP,IEL2)=0.D0
404 : ELSE
405 : CCGRV1.POIPR1(IPP,IEL1)=NPDUAL
406 : RETRHO.VALMA1(IPD,IPP,IEL1)=0.D0
407 : RETROU.VALMA1(IPD,IPP,IEL1)=0.D0
408 : RETROV.VALMA1(IPD,IPP,IEL1)=0.D0
409 : ENDIF
410 : ELSE
411 : * Les contributions 1 valent :
412 : * (d Res_{\rho e_t})_d / (d var)_p =
413 : * +/-1 (normale sortante, rentrante) (1/V_d) * (S_f) * \mu
414 : * * [ [ [ (n_x * (( 4/3 * u_f * \alpha_x) + (v_f * \alpha_y)))
415 : * + (n_y * ((u_f * \alpha_y) + (-2/3 * v_f * \alpha_x)))
416 : * ]
417 : * * ((du)_p / (d var)_p)
418 : * ]
419 : * + [ [ (n_x * ((-2/3 * u_f * \alpha_y) + (v_f * \alpha_x)))
420 : * + (n_y * ((u_f * \alpha_x) + ( 4/3 * v_f * \alpha_y)))
421 : * ]
422 : * * ((dv)_p / (d var)_p)
423 : * ]
424 : * ]
425 : NLCENP=KRCENT.LECT(NPPRIM)
426 : IF (NLCENP.EQ.0) THEN
427 : WRITE(IOIMP,*) 'Erreur grave n°2'
428 : GOTO 9999
429 : ENDIF
430 : * normale sortante pour IPD=1, rentrante pour IPD=2
431 : SIGNOR=(-1.D0)**(IPD+1)
432 : VOLUEL=MPVOLU.VPOCHA(NLCEND,1)
433 : SURFFA=MPSURF.VPOCHA(NLFACE,1)
434 : CNX =MPNORM.VPOCHA(NLFACE,1)
435 : CNY =MPNORM.VPOCHA(NLFACE,2)
436 : ALPHAX=KDUNDX.VELCHE(IPP+1,IELEM)
437 : ALPHAY=KDUNDY.VELCHE(IPP+1,IELEM)
438 : RHOP =MPROC.VPOCHA(NLCENP,1)
439 : UP =MPVITC.VPOCHA(NLCENP,1)
440 : VP =MPVITC.VPOCHA(NLCENP,2)
441 : FACTOR=SIGNOR*(1.D0/VOLUEL)*SURFFA*MU
442 : FACTDU=(CNX*((( 4.D0/3.D0)*UXF*ALPHAX)
443 : $ +(UYF*ALPHAY)))
444 : $ + (CNY*((UXF*ALPHAY)
445 : $ +((-2.D0/3.D0)*UYF*ALPHAX)))
446 : FACTDV=(CNX*(((-2.D0/3.D0)*UXF*ALPHAY)
447 : $ +(UYF*ALPHAX)))
448 : $ + (CNY*((UXF*ALPHAX)
449 : $ +(( 4.D0/3.D0)*UYF*ALPHAY)))
450 : DUDRHO=-UP /RHOP
451 : DUDROU=1.D0/RHOP
452 : DVDRHO=-VP /RHOP
453 : DVDROV=1.D0/RHOP
454 : IF (.NOT.LMUR) THEN
455 : CCGRV1.POIPR2(IPP,IEL2)=NPPRIM
456 : RETRHO.VALMA2(IPD,IPP,IEL2)=
457 : $ FACTOR*( (FACTDU*DUDRHO)
458 : $ +(FACTDV*DVDRHO))
459 : RETROU.VALMA2(IPD,IPP,IEL2)=
460 : $ FACTOR* (FACTDU*DUDROU)
461 : RETROV.VALMA2(IPD,IPP,IEL2)=
462 : $ FACTOR* (FACTDV*DVDROV)
463 : ELSE
464 : CCGRV1.POIPR1(IPP,IEL1)=NPPRIM
465 : RETRHO.VALMA1(IPD,IPP,IEL1)=
466 : $ FACTOR*( (FACTDU*DUDRHO)
467 : $ +(FACTDV*DVDRHO))
468 : RETROU.VALMA1(IPD,IPP,IEL1)=
469 : $ FACTOR* (FACTDU*DUDROU)
470 : RETROV.VALMA1(IPD,IPP,IEL1)=
471 : $ FACTOR* (FACTDV*DVDROV)
472 : ENDIF
473 : ENDIF
474 : 124 CONTINUE
475 : 122 CONTINUE
476 : IF (.NOT.LMUR) THEN
477 : IEL2=IEL2+1
478 : ELSE
479 : IEL1=IEL1+1
480 : ENDIF
481 : ENDIF
482 : 12 CONTINUE
483 : NPP1=NPTEL-1
484 : NPP2=NPTEL-1
485 : NEL1=IEL1-1
486 : NEL2=IEL2-1
487 : SEGADJ RETRHO
488 : SEGADJ RETROU
489 : SEGADJ RETROV
490 : SEGADJ CCGRV1
491 : CCGRV1.LMATSI(**)=RETRHO
492 : CCGRV1.LMATSI(**)=RETROU
493 : CCGRV1.LMATSI(**)=RETROV
494 : * On accumule les matrices résultantes dans IJACO
494 : CALL AJMTK(CCGRV1,IJACO,IMPR,IRET)
495 : IF (IRET.NE.0) GOTO 9999
496 : SEGSUP RETRHO
497 : SEGSUP RETROU
498 : SEGSUP RETROV
499 : SEGSUP CCGRV1
500 : *
501 : SEGDES MCOGRV
502 : SEGDES KDUNDY
503 : SEGDES KDUNDX
504 : 1 CONTINUE
505 : SEGDES ICOGRV
506 : SEGDES MPGRVF
507 : SEGDES MPVITC
508 : SEGDES MPMUC
509 : SEGDES MPROC
510 : SEGDES MPVOLU
511 : SEGDES MPNORM
512 : SEGDES MPSURF
513 : SEGDES MELEFL
514 : SEGDES KRFACE
515 : SEGDES KRCENT
516 : SEGDES NOMINC
517 : IF (LCLITO) THEN
518 : SEGDES KRTOIM
519 : ENDIF
520 : IF (LCLIMV) THEN
521 : SEGDES KRVIMP
522 : SEGDES MPVIMP
523 : ENDIF
524 : *
525 : * Normal termination
526 : *
527 : IRET=0
528 : RETURN
529 : *
530 : * Format handling
531 : *
532 : *
533 : * Error handling
534 : *
535 : 9999 CONTINUE
536 : IRET=1
537 : WRITE(IOIMP,*) 'An error was detected in subroutine xlap1e'
538 : RETURN
539 : *
540 : * End of subroutine XLAP1E
541 : *
542 : END
543 :
544 :
545 :
546 :
547 :
548 :
549 :
550 :
© Cast3M 2003 - All rights reserved.
Disclaimer