1 : C YLAP1E SOURCE MAGN 09/07/30 21:22:21 6458
2 : SUBROUTINE YLAP1E(ICOGRV,MPGRVF,MPROC,MPVITC,
3 : $ MPVOLU,MPNORM,MPSURF,MELEFL,
4 : $ KRFACE,KRCENT,
5 : $ LCLIMV,KRVIMP,MPVIMP,
6 : $ LCLITO,KRTOIM,
7 : $ NOMINC,
8 : $ MU,
9 : $ IJACO,
10 : $ IMPR,IRET)
11 : IMPLICIT INTEGER(I-N)
12 : IMPLICIT REAL*8 (A-H,O-Z)
13 : C***********************************************************************
14 : C NOM : YLAP1E
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. ylap1c) car on a à dériver des produits
26 : C de fonctions de la vitesse.
27 : C ylap1d 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 : YLAP1A : 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 MU (type réel) : 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, 21/08/2001, version initiale
83 : C HISTORIQUE : v1, 21/08/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 MPROC.MPOVAL ,MPVITC.MPOVAL
96 : POINTEUR MPSURF.MPOVAL,MPNORM.MPOVAL,MPVOLU.MPOVAL
97 : POINTEUR MPVIMP.MPOVAL
98 : -INC SMCHAML
99 : POINTEUR ICOGRV.MCHELM,JCOGRV.MCHAML
100 : POINTEUR KDUNDX.MELVAL,KDUNDY.MELVAL
101 : -INC SMELEME
102 : POINTEUR MELEFL.MELEME
103 : POINTEUR MCOGRV.MELEME
104 : -INC SMLENTI
105 : POINTEUR KRVIMP.MLENTI,KRTOIM.MLENTI
106 : POINTEUR KRCENT.MLENTI,KRFACE.MLENTI
107 : -INC SMLMOTS
108 : POINTEUR NOMINC.MLMOTS
109 : -INC SMMATRIK
110 : POINTEUR IJACO.MATRIK
111 : *
112 : * Objet matrice élémentaire simplifié
113 : *
114 : SEGMENT GMATSI
115 : INTEGER POIPR1(NPP1,NEL1)
116 : INTEGER POIDU1(1,NEL1)
117 : INTEGER POIPR2(NPP2,NEL2)
118 : INTEGER POIDU2(2,NEL2)
119 : POINTEUR LMATSI(0).MATSIM
120 : ENDSEGMENT
121 : * Contributions compliquées 1 de la part du gradient de
122 : * vitesse (CCGRV1)
123 : POINTEUR CCGRV1.GMATSI
124 : SEGMENT MATSIM
125 : CHARACTER*8 NOMPRI,NOMDUA
126 : REAL*8 VALMA1(1,NPP1,NEL1)
127 : REAL*8 VALMA2(2,NPP2,NEL2)
128 : ENDSEGMENT
129 : POINTEUR RETRHO.MATSIM
130 : POINTEUR RETROU.MATSIM
131 : POINTEUR RETROV.MATSIM
132 : *
133 : REAL*8 MU
134 : *
135 : INTEGER IMPR,IRET
136 : *
137 : LOGICAL LCLIMV,LCLITO
138 : LOGICAL LMUR
139 : LOGICAL LCTR1A,LCTR1B
140 : *
141 : INTEGER IELEM,IPD,IPP,ISOUCH,IEL1,IEL2
142 : INTEGER NELEM,NPD,NPP,NSOUCH,NEL1,NEL2,NPP1,NPP2
143 : INTEGER NGCDRO,NGCGAU,NGFACE,NPPRIM,NPDUAL
144 : INTEGER NLCENP,NLCEND,NLFACE,NLCLTO,NLCLV
145 : INTEGER NLCED,NLCEG,NLFVI
146 : INTEGER NPTEL
147 : INTEGER ICOORX
148 : *
149 : REAL*8 ALPHA,UMALPH
150 : REAL*8 DRD,DRG
151 : REAL*8 DUXXF,DUXYF,DUYXF,DUYYF
152 : REAL*8 UXD,UXF,UXG,UYD,UYF,UYG
153 : REAL*8 XD,XF,XG,XFMXD,XFMXG
154 : REAL*8 YD,YF,YG,YFMYD,YFMYG
155 : REAL*8 ALPHAX,ALPHAY,CNX,CNY
156 : REAL*8 SIGNOR,SURFFA,VOLUEL
157 : REAL*8 RHOP,UP,VP
158 : REAL*8 FACTOR,FACTDU,FACTDV
159 : REAL*8 DUDRHO,DUDROU,DVDRHO,DVDROV
160 : *
161 : * Executable statements
162 : *
163 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans ylap1e.eso'
164 : * On calcule les contributions à (d Res_{\rho e_t} / d var) ; var
165 : * prenant successivement les valeurs :
166 : * \rho, \rho u, \rho v, \rho e_t
167 : * On dérive les termes : (\tens{\tau(\grad{u})} \prod \vect{u})
168 : * \pscal \vect{n}
169 : * ce qui donne deux contributions.
170 : * Contribution 1 :
171 : * ( (d \tens{\tau} / d var) \prod \vect{u}) \pscal \vect{n}
172 : * Contribution 2 :
173 : * ( \tens{\tau} \prod (d \vect{u} / d var)) \pscal \vect{n}
174 : * Note :
175 : * pas de contribution à (d Res_{\rho e_t} / d \rho e_t).
176 : * Les noms de matrices élémentaires (type MATSIM) associées sont :
177 : * RETRHO, RETROU, RETROV
178 : IF (LCLIMV) THEN
179 : SEGACT KRVIMP
180 : SEGACT MPVIMP
181 : ENDIF
182 : IF (LCLITO) THEN
183 : SEGACT KRTOIM
184 : ENDIF
185 : SEGACT NOMINC
186 : SEGACT KRCENT
187 : SEGACT KRFACE
188 : SEGACT MELEFL
189 : SEGACT MPSURF
190 : SEGACT MPNORM
191 : SEGACT MPVOLU
192 : SEGACT MPROC
193 : SEGACT MPVITC
194 : SEGACT MPGRVF
195 : SEGACT ICOGRV
196 : NSOUCH=ICOGRV.IMACHE(/1)
197 : DO 1 ISOUCH=1,NSOUCH
198 : MCOGRV=ICOGRV.IMACHE(ISOUCH)
199 : JCOGRV=ICOGRV.ICHAML(ISOUCH)
200 : SEGACT JCOGRV
201 : KDUNDX=JCOGRV.IELVAL(1)
202 : KDUNDY=JCOGRV.IELVAL(2)
203 : SEGDES JCOGRV
204 : SEGACT KDUNDX
205 : SEGACT KDUNDY
206 : SEGACT MCOGRV
207 : NELEM=MCOGRV.NUM(/2)
208 : NPTEL=MCOGRV.NUM(/1)
209 : NPP1=NPTEL-1
210 : NPP2=NPTEL-1
211 : NEL1=NELEM
212 : NEL2=NELEM
213 : IEL1=1
214 : IEL2=1
215 : SEGINI RETRHO
216 : SEGINI RETROU
217 : SEGINI RETROV
218 : SEGINI CCGRV1
219 : RETRHO.NOMPRI(1:4)=NOMINC.MOTS(1)
220 : RETRHO.NOMPRI(5:8)=' '
221 : RETRHO.NOMDUA(1:4)=NOMINC.MOTS(4)
222 : RETRHO.NOMDUA(5:8)=' '
223 : RETROU.NOMPRI(1:4)=NOMINC.MOTS(2)
224 : RETROU.NOMPRI(5:8)=' '
225 : RETROU.NOMDUA(1:4)=NOMINC.MOTS(4)
226 : RETROU.NOMDUA(5:8)=' '
227 : RETROV.NOMPRI(1:4)=NOMINC.MOTS(3)
228 : RETROV.NOMPRI(5:8)=' '
229 : RETROV.NOMDUA(1:4)=NOMINC.MOTS(4)
230 : RETROV.NOMDUA(5:8)=' '
231 : DO 12 IELEM=1,NELEM
232 : * Le premier point du support de ICOGRV est un point FACE
233 : NGFACE=MCOGRV.NUM(1,IELEM)
234 : NLFACE=KRFACE.LECT(NGFACE)
235 : IF (NLFACE.EQ.0) THEN
236 : WRITE(IOIMP,*) 'Erreur de programmation n°1'
237 : GOTO 9999
238 : ENDIF
239 : * On calcule la contribution 1 à la matrice jacobienne IJACO de la
240 : * face NGFACE
241 : * (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 1 de la face à IJACO est
247 : * nulle.
248 : LCTR1A=.TRUE.
249 : IF (LCLITO) THEN
250 : NLCLTO=KRTOIM.LECT(NGFACE)
251 : IF (NLCLTO.NE.0) THEN
252 : LCTR1A=.FALSE.
253 : ENDIF
254 : ENDIF
255 : IF (LCTR1A) THEN
256 : NGCGAU=MELEFL.NUM(1,NLFACE)
257 : NGCDRO=MELEFL.NUM(3,NLFACE)
258 : LMUR=(NGCGAU.EQ.NGCDRO)
259 : * On calcule tout d'abord une interpolation de la vitesse sur la
260 : * face NGFACE de la même manière que dans ylap12.eso.
261 : IF (LCLIMV) THEN
262 : NLFVI=KRVIMP.LECT(NGFACE)
263 : ELSE
264 : NLFVI=0
265 : ENDIF
266 : * La vitesse est imposée sur la face, rien à calculer
267 : IF (NLFVI.NE.0) THEN
268 : UXF=MPVIMP.VPOCHA(NLFVI,1)
269 : UYF=MPVIMP.VPOCHA(NLFVI,2)
270 : ELSE
271 : NLCEG=KRCENT.LECT(NGCGAU)
272 : NLCED=KRCENT.LECT(NGCDRO)
273 : * Cas non au bord
274 : IF (.NOT.LMUR) THEN
275 : * Paramètres géométriques
276 : ICOORX = ((IDIM + 1) * (NGFACE - 1))+1
277 : XF = MCOORD.XCOOR(ICOORX)
278 : YF = MCOORD.XCOOR(ICOORX+1)
279 : ICOORX = ((IDIM + 1) * (NGCGAU - 1))+1
280 : XG = MCOORD.XCOOR(ICOORX)
281 : YG = MCOORD.XCOOR(ICOORX+1)
282 : XFMXG = XF - XG
283 : YFMYG = YF - YG
284 : DRG=SQRT((XFMXG*XFMXG)+(YFMYG*YFMYG))
285 : ICOORX = ((IDIM + 1) * (NGCDRO - 1))+1
286 : XD = MCOORD.XCOOR(ICOORX)
287 : YD = MCOORD.XCOOR(ICOORX+1)
288 : XFMXD = XF - XD
289 : YFMYD = YF - YD
290 : DRD=SQRT((XFMXD*XFMXD)+(YFMYD*YFMYD))
291 : ALPHA=DRG/(DRG+DRD)
292 : UMALPH= 1.0D0 - ALPHA
293 : DUXXF = MPGRVF.VPOCHA(NLFACE,1)
294 : DUXYF = MPGRVF.VPOCHA(NLFACE,2)
295 : DUYXF = MPGRVF.VPOCHA(NLFACE,3)
296 : DUYYF = MPGRVF.VPOCHA(NLFACE,4)
297 : * Calcul de la vitesse
298 : UXG = MPVITC.VPOCHA(NLCEG,1)
299 : UYG = MPVITC.VPOCHA(NLCEG,2)
300 : UXD = MPVITC.VPOCHA(NLCED,1)
301 : UYD = MPVITC.VPOCHA(NLCED,2)
302 : UXF = UMALPH * UXG + ALPHA * UXD
303 : UYF = UMALPH * UYG + ALPHA * UYD
304 : * Correction de la vitesse lineaire exacte
305 : UXF = UXF +
306 : $ (DUXXF * ((XFMXG * UMALPH)+ (XFMXD * ALPHA)))
307 : $ +(DUXYF * ((YFMYG * UMALPH)+ (YFMYD * ALPHA)))
308 : UYF = UYF +
309 : $ (DUYXF * ((XFMXG * UMALPH)+ (XFMXD * ALPHA)))
310 : $ +(DUYYF * ((YFMYG * UMALPH)+ (YFMYD * ALPHA)))
311 :
312 : * Cas au bord
313 : ELSE
314 : * Parametres geometriques
315 : ICOORX = ((IDIM + 1) * (NGFACE - 1))+1
316 : XF = MCOORD.XCOOR(ICOORX)
317 : YF = MCOORD.XCOOR(ICOORX+1)
318 : ICOORX = ((IDIM + 1) * (NGCGAU - 1))+1
319 : XG = MCOORD.XCOOR(ICOORX)
320 : YG = MCOORD.XCOOR(ICOORX+1)
321 : XFMXG = XF - XG
322 : YFMYG = YF - YG
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 : UXF = MPVITC.VPOCHA(NLCEG,1)
329 : UYF = MPVITC.VPOCHA(NLCEG,2)
330 : * Correction de la vitesse lineaire exacte
331 : UXF = UXF + (DUXXF * XFMXG ) + (DUXYF * YFMYG )
332 : UYF = UYF + (DUYXF * XFMXG ) + (DUYYF * YFMYG )
333 : ENDIF
334 : ENDIF
335 : * On distingue le cas où la face est un bord du maillage (mur)
336 : * du cas où la face est interne au maillage
337 : IF (.NOT.LMUR) THEN
338 : NPD=2
339 : ELSE
340 : NPD=1
341 : ENDIF
342 : NPP=NPTEL-1
343 : * IPD=1 : point à gauche du point NGFACE
344 : * IPD=2 : point à droite du point NGFACE
345 : DO 122 IPD=1,NPD
346 : NPDUAL=MELEFL.NUM((2*IPD)-1,NLFACE)
347 : IF (.NOT.LMUR) THEN
348 : CCGRV1.POIDU2(IPD,IEL2)=NPDUAL
349 : ELSE
350 : CCGRV1.POIDU1(IPD,IEL1)=NPDUAL
351 : ENDIF
352 : NLCEND=KRCENT.LECT(NPDUAL)
353 : IF (NLCEND.EQ.0) THEN
354 : WRITE(IOIMP,*) 'Erreur grave n°1'
355 : GOTO 9999
356 : ENDIF
357 : DO 124 IPP=1,NPP
358 : NPPRIM=MCOGRV.NUM(IPP+1,IELEM)
359 : C
360 : C******************* Modif AB: we do not check the B.C. anymore
361 : C
362 : NLCENP=KRCENT.LECT(NPPRIM)
363 : IF(NLCENP .EQ. 0)THEN
364 : * Lorsque une contribution est nulle, on fixe artificiellement le
365 : * point primal égal au point dual.
366 : IF (.NOT.LMUR) THEN
367 : CCGRV1.POIPR2(IPP,IEL2)=NPDUAL
368 : RETRHO.VALMA2(IPD,IPP,IEL2)=0.D0
369 : RETROU.VALMA2(IPD,IPP,IEL2)=0.D0
370 : RETROV.VALMA2(IPD,IPP,IEL2)=0.D0
371 : ELSE
372 : CCGRV1.POIPR1(IPP,IEL1)=NPDUAL
373 : RETRHO.VALMA1(IPD,IPP,IEL1)=0.D0
374 : RETROU.VALMA1(IPD,IPP,IEL1)=0.D0
375 : RETROV.VALMA1(IPD,IPP,IEL1)=0.D0
376 : ENDIF
377 : ELSE
378 : * Les contributions 1 valent :
379 : * (d Res_{\rho e_t})_d / (d var)_p =
380 : * +/-1 (normale sortante, rentrante) (1/V_d) * (S_f) * \mu
381 : * * [ [ [ (n_x * (( 4/3 * u_f * \alpha_x) + (v_f * \alpha_y)))
382 : * + (n_y * ((u_f * \alpha_y) + (-2/3 * v_f * \alpha_x)))
383 : * ]
384 : * * ((du)_p / (d var)_p)
385 : * ]
386 : * + [ [ (n_x * ((-2/3 * u_f * \alpha_y) + (v_f * \alpha_x)))
387 : * + (n_y * ((u_f * \alpha_x) + ( 4/3 * v_f * \alpha_y)))
388 : * ]
389 : * * ((dv)_p / (d var)_p)
390 : * ]
391 : * ]
392 : C
393 : * normale sortante pour IPD=1, rentrante pour IPD=2
394 : SIGNOR=(-1.D0)**(IPD+1)
395 : VOLUEL=MPVOLU.VPOCHA(NLCEND,1)
396 : SURFFA=MPSURF.VPOCHA(NLFACE,1)
397 : CNX =MPNORM.VPOCHA(NLFACE,1)
398 : CNY =MPNORM.VPOCHA(NLFACE,2)
399 : ALPHAX=KDUNDX.VELCHE(IPP+1,IELEM)
400 : ALPHAY=KDUNDY.VELCHE(IPP+1,IELEM)
401 : RHOP =MPROC.VPOCHA(NLCENP,1)
402 : UP =MPVITC.VPOCHA(NLCENP,1)
403 : VP =MPVITC.VPOCHA(NLCENP,2)
404 : FACTOR=SIGNOR*(1.D0/VOLUEL)*SURFFA*MU
405 : FACTDU=(CNX*((( 4.D0/3.D0)*UXF*ALPHAX)
406 : $ +(UYF*ALPHAY)))
407 : $ + (CNY*((UXF*ALPHAY)
408 : $ +((-2.D0/3.D0)*UYF*ALPHAX)))
409 : FACTDV=(CNX*(((-2.D0/3.D0)*UXF*ALPHAY)
410 : $ +(UYF*ALPHAX)))
411 : $ + (CNY*((UXF*ALPHAX)
412 : $ +(( 4.D0/3.D0)*UYF*ALPHAY)))
413 : DUDRHO=-UP /RHOP
414 : DUDROU=1.D0/RHOP
415 : DVDRHO=-VP /RHOP
416 : DVDROV=1.D0/RHOP
417 : IF (.NOT.LMUR) THEN
418 : CCGRV1.POIPR2(IPP,IEL2)=NPPRIM
419 : RETRHO.VALMA2(IPD,IPP,IEL2)=
420 : $ FACTOR*( (FACTDU*DUDRHO)
421 : $ +(FACTDV*DVDRHO))
422 : RETROU.VALMA2(IPD,IPP,IEL2)=
423 : $ FACTOR* (FACTDU*DUDROU)
424 : RETROV.VALMA2(IPD,IPP,IEL2)=
425 : $ FACTOR* (FACTDV*DVDROV)
426 : ELSE
427 : CCGRV1.POIPR1(IPP,IEL1)=NPPRIM
428 : RETRHO.VALMA1(IPD,IPP,IEL1)=
429 : $ FACTOR*( (FACTDU*DUDRHO)
430 : $ +(FACTDV*DVDRHO))
431 : RETROU.VALMA1(IPD,IPP,IEL1)=
432 : $ FACTOR* (FACTDU*DUDROU)
433 : RETROV.VALMA1(IPD,IPP,IEL1)=
434 : $ FACTOR* (FACTDV*DVDROV)
435 : ENDIF
436 : ENDIF
437 : 124 CONTINUE
438 : 122 CONTINUE
439 : IF (.NOT.LMUR) THEN
440 : IEL2=IEL2+1
441 : ELSE
442 : IEL1=IEL1+1
443 : ENDIF
444 : ENDIF
445 : 12 CONTINUE
446 : NPP1=NPTEL-1
447 : NPP2=NPTEL-1
448 : NEL1=IEL1-1
449 : NEL2=IEL2-1
450 : SEGADJ RETRHO
451 : SEGADJ RETROU
452 : SEGADJ RETROV
453 : SEGADJ CCGRV1
454 : CCGRV1.LMATSI(**)=RETRHO
455 : CCGRV1.LMATSI(**)=RETROU
456 : CCGRV1.LMATSI(**)=RETROV
457 : * On accumule les matrices résultantes dans IJACO
457 : CALL AJMTK(CCGRV1,IJACO,IMPR,IRET)
458 : IF (IRET.NE.0) GOTO 9999
459 : SEGSUP RETRHO
460 : SEGSUP RETROU
461 : SEGSUP RETROV
462 : SEGSUP CCGRV1
463 : *
464 : SEGDES MCOGRV
465 : SEGDES KDUNDY
466 : SEGDES KDUNDX
467 : 1 CONTINUE
468 : SEGDES ICOGRV
469 : SEGDES MPGRVF
470 : SEGDES MPVITC
471 : SEGDES MPROC
472 : SEGDES MPVOLU
473 : SEGDES MPNORM
474 : SEGDES MPSURF
475 : SEGDES MELEFL
476 : SEGDES KRFACE
477 : SEGDES KRCENT
478 : SEGDES NOMINC
479 : IF (LCLITO) THEN
480 : SEGDES KRTOIM
481 : ENDIF
482 : IF (LCLIMV) THEN
483 : SEGDES KRVIMP
484 : SEGDES MPVIMP
485 : ENDIF
486 : *
487 : * Normal termination
488 : *
489 : IRET=0
490 : RETURN
491 : *
492 : * Format handling
493 : *
494 : *
495 : * Error handling
496 : *
497 : 9999 CONTINUE
498 : IRET=1
499 : WRITE(IOIMP,*) 'An error was detected in subroutine ylap1e'
500 : RETURN
501 : *
502 : * End of subroutine YLAP1E
503 : *
504 : END
505 :
506 :
507 :
508 :
509 :
510 :
511 :
512 :
© Cast3M 2003 - All rights reserved.
Disclaimer