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