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