1 : C KRES5 SOURCE GOUNAND 12/04/12 21:15:07 7352 2 : SUBROUTINE KRES5(MATRIK,KCLIM,KSMBR,KTYPI, 3 : $ MCHINI,ITER,RESID, 4 : $ BRTOL,RESTRT,LBCG,ICALRS, 5 : $ MAPREC,KPREC, 6 : $ RXMILU,RXILUP,XLFIL,XDTOL,XSPIV, 7 : $ ISCAL, 8 : $ KTIME,LTIME,IDDOT,IMVEC, 9 : $ MCHSOL,LRES,LNMV,ICVG, 10 : $ IMPR,IRET) 11 : IMPLICIT REAL*8 (A-H,O-Z) 12 : IMPLICIT INTEGER (I-N) 13 : C*********************************************************************** 14 : C NOM : KRES5 15 : C DESCRIPTION : Résolution d'un système par une méthode itérative 16 : C (type gradient conjugué). 17 : C 18 : C 19 : C LANGAGE : ESOPE 20 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 21 : C mél : gounand@semt2.smts.cea.fr 22 : C*********************************************************************** 23 : C APPELES : VERMAT, MEXINI, MESMBR, MELIM, INFMAT, 24 : C MEIDIA, PRDILU, PRILU, PRMILU, PRILUT, 25 : C PRCG, PRBCGS, PRBCS2, PRGMR, 26 : C XDISP 27 : C APPELE PAR : KRES2 28 : C*********************************************************************** 29 : C ENTREES : MATRIK, KCLIM, KSMBR, KTYPI, MCHINI, ITER, RESID, 30 : C BRTOL, RESTRT, MAPREC, KPREC, RXMILU, XLFIL, 31 : C XDTOL 32 : C ENTREES/SORTIES : - 33 : C SORTIES : MCHSOL, LRES 34 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 35 : C*********************************************************************** 36 : C VERSION : v1, 14/04/2000, version initiale 37 : C HISTORIQUE : v1, 14/04/2000, création 38 : C HISTORIQUE : 06/04/04 : Scaling 39 : C HISTORIQUE : 08/04/04 : ajout ILUTP 40 : C HISTORIQUE : 41 : C*********************************************************************** 42 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 43 : C en cas de modification de ce sous-programme afin de faciliter 44 : C la maintenance ! 45 : C*********************************************************************** 46 : -INC CCOPTIO 47 : -INC SMLENTI 48 : POINTEUR LNMV.MLENTI 49 : POINTEUR ATYP.MLENTI 50 : -INC SMLREEL 51 : POINTEUR LRES.MLREEL 52 : -INC SMCHPOI 53 : POINTEUR KCLIM.MCHPOI 54 : POINTEUR KSMBR.MCHPOI 55 : POINTEUR MCHINI.MCHPOI 56 : POINTEUR MCHSOL.MCHPOI 57 : -INC SMMATRIK 58 : POINTEUR MAPREC.MATRIK 59 : POINTEUR INCX.IZA 60 : POINTEUR KS2B.IZA 61 : POINTEUR KMORS.PMORS 62 : POINTEUR KISA.IZA 63 : POINTEUR AMORS.PMORS 64 : POINTEUR AISA.IZA 65 : POINTEUR NORMP.IZA 66 : POINTEUR NORMD.IZA 67 : * 68 : * .. Parameters 69 : REAL*8 ZERO ,ONE 70 : PARAMETER (ZERO=0.0D0,ONE=1.0D0) 71 : * Paramètre m du GMRES(m) 72 : INTEGER RESTRT 73 : INTEGER ITER,IVARI 74 : REAL*8 BRTOL,RESID,RXMILU,RXILUP 75 : * 76 : REAL*8 XLFIL,XDTOL 77 : INTEGER KPREC 78 : INTEGER KTYPI 79 : C LOGICAL LCLZER 80 : LOGICAL LRACOU 81 : LOGICAL LFIRST 82 : C 83 : INTEGER IMPR,IRET 84 : C Tableau de correspondance : entier <-> mot 85 : C pour le type d'inversion 86 : INTEGER NBTYPI,LNTYPI 87 : PARAMETER (NBTYPI=9) 88 : PARAMETER (LNTYPI=18) 89 : CHARACTER*(LNTYPI) LTYPI(NBTYPI) 90 : C Tableau de correspondance : entier <-> mot 91 : C pour le type de préconditionnement (cas d'une méthode itérative) 92 : INTEGER NBPREC,LNPREC 93 : PARAMETER (NBPREC=11) 94 : PARAMETER (LNPREC=8) 95 : CHARACTER*(LNPREC) LPREC(NBPREC) 96 : -INC SMTABLE 97 : POINTEUR KTIME.MTABLE 98 : DIMENSION ITTIME(6) 99 : CHARACTER*8 CHARI 100 : CHARACTER*1 CCOMP 101 : LOGICAL LTIME 102 : C 103 : C Initialisation des tableaux 104 : C 105 : DATA LTYPI/'Choleski ', 106 : $ 'Conjugate Gradient', 107 : $ 'BiCGSTAB G ', 108 : $ 'BiCGSTAB(l) G ', 109 : $ 'GMRES(m) ', 110 : $ 'CGS-Neumaier ', 111 : $ 'Multigrid FCG ', 112 : $ 'Multigrid GCR(m) ', 113 : $ 'Bi-CG '/ 114 : DATA LPREC/'None ', 115 : $ 'Jacobi ', 116 : $ 'D-ILU ', 117 : $ 'ILU(0) ', 118 : $ 'MILU(0) ', 119 : $ 'ILUT ', 120 : $ 'ILUT2 ', 121 : $ 'ILUTP ', 122 : $ 'ILUTP+0 ', 123 : $ 'ILU0-PV ', 124 : $ 'ILU0-PVf'/ 125 : * 126 : * Executable statements 127 : * 128 : ICVG=0 129 : IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans kres5.eso' 130 : C Batterie de tests 131 : C 132 : C KTYPI : Méthode d'inversion du système (cf. LTYPI) 133 : C 1 : résolution directe (Choleski) 134 : C 2 : Gradient Conjugué 135 : C 3 : Bi-Gradient Conjugué Stabilisé (BiCGSTAB) 136 : C 4 : BiCGSTAB(2) 137 : C 5 : GMRES(m) 138 : C 6 : CGS 139 : C 7 : Multigrille symétrique 140 : C 8 : Multigrille non symétrique 141 : C 9 : BiCG 142 : IF (KTYPI.LT.2.OR.KTYPI.GT.NBTYPI) THEN 143 : WRITE(IOIMP,*) 'KTYPI incorrect (2..',NBTYPI,') :',KTYPI 144 : GOTO 9999 145 : ENDIF 146 : * Pas de préconditionnement en cas de multigrille 147 : C - Type de préconditionnement : (cf. LPREC) 148 : C 0 : pas de préconditionnement 149 : C 1 : préconditionnement par la diagonale 150 : C 2 : préconditionnement D-ILU 151 : C 3 : préconditionnement ILU(0) (Choleski) 152 : C 4 : préconditionnement MILU(0) (Choleski modifié) 153 : C 5 : préconditionnement ILUT (dual truncation) 154 : C 6 : préconditionnement ILUT2 (une variante du 155 : C précédent qui remplit mieux la mémoire et 156 : C fonctionne mieux quelquefois) 157 : C 7 : préconditionnement ILUTP 158 : C 8 : préconditionnement ILUTP version Goon 159 : C 9 : préconditionnement ILU-PV 160 : C 10 : préconditionnement ILU-PVf 161 : IF (KPREC.LT.0.OR.KPREC.GT.NBPREC-1) THEN 162 : WRITE(IOIMP,*) 'PRECOND ', 163 : $ 'incorrect (0..',NBPREC-1,') :',KPREC 164 : GOTO 9999 165 : ENDIF 166 : C 167 : C On vérifie que la matrice est correctement assemblée 168 : C 168 : CALL VERMAT(MATRIK,IMPR,IRET) 169 : IF (IRET.NE.0) GOTO 9999 170 : C 171 : C On transforme le chpoint estimation initiale de l'inconnue en vecteur 172 : C estimation initiale de l'inconnue 173 : C In MEXINI : SEGINI INCX 173 : CALL MEXINI(MATRIK,MCHINI, 174 : $ INCX, 175 : $ IMPR,IRET) 176 : IF (IRET.NE.0) GOTO 9999 177 : C 178 : C On transforme le chpoint second membre en vecteur second membre 179 : C In MESMBR : SEGINI KS2B 179 : CALL MESMBR(MATRIK,KSMBR, 180 : $ KS2B, 181 : $ IMPR,IRET) 182 : IF (IRET.NE.0) GOTO 9999 183 : C 184 : C On applique les conditions aux limites 185 : C 186 : LRACOU=(KCLIM.EQ.0) 187 : * LRACOU=.FALSE. 188 : * WRITE(IOIMP,*) 'LRACOU=',LRACOU 189 : IF (LRACOU) THEN 190 : SEGACT MATRIK 191 : AMORS=MATRIK.KIDMAT(4) 192 : AISA=MATRIK.KIDMAT(5) 193 : SEGDES MATRIK 194 : ELSE 195 : C 196 : C In MELIM : SEGINI AMORS 197 : C SEGINI AISA 197 : CALL MELIM(MATRIK,KCLIM, 198 : $ INCX,KS2B, 199 : $ AMORS,AISA, 200 : $ IMPR,IRET) 201 : IF (IRET.NE.0) GOTO 9999 202 : ENDIF 203 : C 204 : LFIRST=.FALSE. 205 : IF (ISCAL.GT.0) THEN 206 : IF (LRACOU) THEN 207 : SEGACT MATRIK 208 : NORMP=MATRIK.KKMMT(4) 209 : NORMD=MATRIK.KKMMT(5) 210 : SEGDES MATRIK 211 : IF (NORMP.EQ.0.AND.NORMD.EQ.0) THEN 212 : LFIRST=.TRUE. 213 : ENDIF 214 : ELSE 215 : NORMP=0 216 : NORMD=0 217 : ENDIF 218 : IF (NORMP.EQ.0.OR.NORMD.EQ.0) THEN 219 : C Calcul des normes primales (colonnes) et duales (lignes) 220 : C de la matrice. Norme = norme L2, soit : 221 : C {\sum_{i ou j} a_{ij}^2}^{1/2} 222 : C 222 : CALL NORMAT(AMORS,AISA,ISCAL,NORMP,NORMD,IMPR,IRET) 223 : IF (IRET.NE.0) GOTO 9999 224 : C 225 : C On norme la matrice : attention modification... 226 : C 226 : CALL NORMAM(AMORS,AISA,NORMP,NORMD,IMPR,IRET) 227 : IF (IRET.NE.0) GOTO 9999 228 : ENDIF 229 : C 230 : C On norme le second membre : attention modification... 231 : C 231 : CALL NORMV2(KS2B,NORMD,IMPR,IRET) 232 : IF (IRET.NE.0) GOTO 9999 233 : C 234 : C On dénorme l'inconnue X : attention modification... 235 : C 235 : CALL NORMV1(INCX,NORMP,IMPR,IRET) 236 : IF (IRET.NE.0) GOTO 9999 237 : ELSE 238 : NORMP=0 239 : NORMD=0 240 : ENDIF 241 : C 242 : C On donne des infos sur la matrice 243 : C 243 : CALL INFMAT(AMORS,AISA,IMPR,IRET) 244 : IF (IRET.NE.0) GOTO 9999 245 : C 246 : C ON CHOISIT LE TYPE D'INVERSION 247 : C 248 : C Méthodes de gradient conjugué 249 : C 250 : C KTYPI = 2 : Gradient conjugué (CG) 251 : C KTYPI = 3 : Bi-Gradient conjugué stabilisé (BiCGSTAB) 252 : C KTYPI = 4 : BiCGSTAB(2) 253 : C KTYPI = 5 : GMRES(m) 254 : C KTYPI = 6 : CGS 255 : C KTYPI = 7 : Algebraic Multigrid FCG 256 : C KTYPI = 8 : Algebraic Multigrid GCR(m) 257 : C KTYPI = 9 : BiCG 258 : C 259 : C KPREC = 0 : pas de préconditionnement 260 : C KPREC = 1 : préconditionnement par la diagonale 261 : C KPREC = 2 : préconditionnement par factorisation incomplete 262 : C D-ILU 263 : C KPREC = 3 : préconditionnement par factorisation incomplete 264 : C ILU(0) (i.e. Crout) 265 : C KPREC = 4 : préconditionnement par factorisation incomplete 266 : C modifiée MILU(0) (i.e. Crout) 267 : C KPREC = 5 : préconditionnement par factorisation incomplete 268 : C ILUT (dual truncation strategy) 269 : C KPREC = 6 : préconditionnement ILUT2 (une variante du 270 : C précédent qui remplit mieux la mémoire et 271 : C fonctionne mieux quelquefois) 272 : C KPREC = 7 : préconditionnement ILUTP 273 : C KPREC = 8 : préconditionnement ILUTPGOO 274 : C KPREC = 9 : préconditionnement ILU-PV 275 : C KPREC = 10 : préconditionnement ILU-PV filtré 276 : IF(KTYPI.GE.2.AND.KTYPI.LE.NBTYPI)THEN 277 : IF (IMPR.GT.1) THEN 278 : IF (IDDOT.EQ.0) CCOMP=' ' 279 : IF (IDDOT.EQ.1) CCOMP='c' 280 : IF (KTYPI.EQ.5.OR.KTYPI.EQ.8) THEN 281 : WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (m=',RESTRT,')' 282 : ELSEIF (KTYPI.EQ.11.OR.KTYPI.EQ.12) THEN 283 : WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (l=',LBCG,')' 284 : ELSE 285 : WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI) 286 : ENDIF 287 : IF (KPREC.EQ.4) THEN 288 : WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXMILU,')' 289 : 110 FORMAT (3A,D9.2,A) 290 : ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN 291 : WRITE(IOIMP,111) ' ',LPREC(KPREC+1),' (lfil=',XLFIL, 292 : $ ' droptol=',XDTOL,')' 293 : 111 FORMAT (3A,D9.2,A,D9.2,A) 294 : ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN 295 : WRITE(IOIMP,112) ' ',LPREC(KPREC+1),' (lfil=',XLFIL, 296 : $ ' droptol=',XDTOL,' pivtol=',XSPIV, 297 : $ ')' 298 : 112 FORMAT (3A,D9.2,A,D9.2,A,D9.2,A,I4,A) 299 : ELSEIF (KPREC.EQ.10) THEN 300 : WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXILUP,')' 301 : ELSE 302 : WRITE(IOIMP,*) LPREC(KPREC+1) 303 : ENDIF 304 : ENDIF 305 : IF (LTIME) THEN 305 : CALL TIMESPV(ITTIME) 306 : ITI1=(ITTIME(1)+ITTIME(2)) 307 : ENDIF 308 : C 309 : C Construction (éventuelle) du préconditionneur 310 : C 311 : IF (KPREC.EQ.1) THEN 311 : CALL MEIDIA(AMORS,AISA,MAPREC,IMPR,IRET) 312 : IF (IRET.NE.0) GOTO 9999 313 : ELSEIF (KPREC.EQ.2) THEN 313 : CALL PRDILU(AMORS,AISA,MAPREC,IMPR,IRET) 314 : IF (IRET.NE.0) GOTO 9999 315 : ELSEIF (KPREC.EQ.3) THEN 315 : CALL PRILU0(AMORS,AISA,MAPREC,IMPR,IRET) 316 : IF (IRET.NE.0) GOTO 9999 317 : ELSEIF (KPREC.EQ.4) THEN 317 : CALL PRMILU(AMORS,AISA,MAPREC,RXMILU,IMPR,IRET) 318 : IF (IRET.NE.0) GOTO 9999 319 : ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN 320 : IVARI=KPREC-5 320 : CALL PRILUT(AMORS,AISA,MAPREC,XLFIL,XDTOL,IVARI, 321 : $ IMPR,IRET) 322 : IF (IRET.NE.0) GOTO 9999 323 : * WRITE(IOIMP,*) 'PRILUT !' 324 : * ELSEIF (KPREC.GE.7.AND.KPREC.LE.9) THEN 325 : ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN 326 : * Ici, on pivote les colonnes lors de la construction du 327 : * préconditionneur... 328 : * On modifiera donc IDMATP et INCX et NORMP 329 : IF (KPREC.EQ.7) THEN 330 : IVARI=0 331 : ELSEIF (KPREC.EQ.8) THEN 332 : IVARI=2 333 : ENDIF 333 : CALL PRILTP(AMORS,AISA,MAPREC,XLFIL,XDTOL,XSPIV, 334 : $ IVARI, 335 : $ INCX,NORMP,LRACOU, 336 : $ IMPR,IRET) 337 : IF (IRET.NE.0) GOTO 9999 338 : ELSEIF (KPREC.EQ.9.OR.KPREC.EQ.10) THEN 338 : CALL PRILUP(AMORS,AISA,MAPREC,RXILUP,KPREC-9,IMPR,IRET) 339 : IF (IRET.NE.0) GOTO 9999 340 : ELSEIF (KPREC.NE.0) THEN 341 : WRITE(IOIMP,*) 'Erreur de programmation' 342 : GOTO 9999 343 : ENDIF 344 : IF (LTIME) THEN 344 : CALL TIMESPV(ITTIME) 345 : ITI2=(ITTIME(1)+ITTIME(2)) 346 : ENDIF 347 : C 348 : C Nettoyage des zéros stockés (utilité ?) 349 : C 350 : IF (LFIRST) THEN 351 : * IIMPR=IMPR 352 : * IMPR=6 352 : CALL CLMORS(AMORS,AISA,IMPR,IRET) 353 : IF (IRET.NE.0) GOTO 9999 354 : * IMPR=IIMPR 355 : ENDIF 356 : * SEGPRT, AMORS 357 : * SEGPRT, AISA 358 : C 359 : C Résolution itérative proprement dite 360 : C 361 : IF (LTIME) THEN 361 : CALL TIMESPV(ITTIME) 362 : ITI3=(ITTIME(1)+ITTIME(2)) 363 : ENDIF 364 : INMV=0 365 : IF (KTYPI.EQ.2) THEN 365 : CALL PRCG2(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 366 : $ ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC, 367 : $ IMPR,IRET) 368 : ELSEIF (KTYPI.EQ.3) THEN 369 : LBCG=1 369 : CALL PRBCGG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 370 : $ ITER,INMV,RESID,KPREC,BRTOL,LBCG,ICALRS,IDDOT,IMVEC, 371 : $ IMPR,IRET) 372 : ELSEIF (KTYPI.EQ.4) THEN 372 : CALL PRBCGG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 373 : $ ITER,INMV,RESID,KPREC,BRTOL,LBCG,ICALRS,IDDOT,IMVEC, 374 : $ IMPR,IRET) 375 : ELSEIF (KTYPI.EQ.5) THEN 375 : CALL PRGMR2(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 376 : $ ITER,INMV,RESID,KPREC,RESTRT,ICALRS,IDDOT,IMVEC, 377 : $ IMPR,IRET) 378 : ELSEIF (KTYPI.EQ.6) THEN 378 : CALL PRCGSN(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 379 : $ ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC, 380 : $ IMPR,IRET) 381 : ELSEIF (KTYPI.EQ.7) THEN 381 : CALL INCTYP(MATRIK, 382 : $ ATYP, 383 : $ IMPR,IRET) 384 : IF (IRET.NE.0) GOTO 9999 385 : * WRITE(IOIMP,*) 'Appel de pragmg' 385 : CALL PRAGMG(AMORS,ATYP,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV, 386 : $ INCX, 387 : $ ITER,INMV,RESID,KPREC,1,ICALRS,IDDOT,IMVEC,KTIME,LTIME, 388 : $ IMPR,IRET) 389 : SEGSUP ATYP 390 : ELSEIF (KTYPI.EQ.8) THEN 390 : CALL INCTYP(MATRIK, 391 : $ ATYP, 392 : $ IMPR,IRET) 393 : IF (IRET.NE.0) GOTO 9999 393 : CALL PRAGMG(AMORS,ATYP,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV, 394 : $ INCX, 395 : $ ITER,INMV,RESID,KPREC,RESTRT,ICALRS,IDDOT,IMVEC, 396 : $ KTIME,LTIME, 397 : $ IMPR,IRET) 398 : SEGSUP ATYP 399 : ELSEIF (KTYPI.EQ.9) THEN 399 : CALL PRBCG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 400 : $ ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC, 401 : $ IMPR,IRET) 402 : ELSE 403 : WRITE(IOIMP,*) 'KTYPI=',KTYPI,' incorrect' 404 : GOTO 9999 405 : ENDIF 406 : C IRET<0 : 'vrai erreur' ou breakdown (dans le cas de BiCGSTAB) 407 : C IRET>0 : l'itération n'a pas convergé mais on veut 408 : C quand meme la solution calculée 409 : ICVG=IRET 410 : IF (IRET.GT.0) THEN 411 : WRITE(IOIMP,*) 'Convergence to tolerance not achieved : ', 412 : $ 'ITER=',ITER,' INMV=',INMV,' RESID=',RESID 413 : ELSEIF (IRET.EQ.0) THEN 414 : IF (IMPR.GT.0) THEN 415 : WRITE(IOIMP,*) 'ITER=',ITER,' INMV=',INMV,' RESID=',RESID 416 : ENDIF 417 : ELSEIF (IRET.LT.0) THEN 418 : WRITE(IOIMP,*) 'Error or breakdown in iterative method' 419 : GOTO 9999 420 : ENDIF 421 : IF (LTIME) THEN 421 : CALL TIMESPV(ITTIME) 422 : ITI4=(ITTIME(1)+ITTIME(2)) 423 : ITP=ITI2-ITI1 424 : ITR=ITI4-ITI3 425 : CHARI='PRECONDI' 425 : CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI, 426 : $ 'ENTIER ',ITP,XVALR,CHARR,LOGIR,IRETR) 427 : CHARI='RESOLUTI' 427 : CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI, 428 : $ 'ENTIER ',ITR,XVALR,CHARR,LOGIR,IRETR) 429 : ENDIF 430 : ELSE 431 : WRITE(IOIMP,*) 'KTYPI=',KTYPI,' invalide (1..',NBTYPI,')' 432 : GOTO 9999 433 : ENDIF 434 : IF (ISCAL.GT.0) THEN 435 : C 436 : C On dénorme le vecteur solution : attention modification... 437 : C 437 : CALL NORMV2(INCX,NORMP,IMPR,IRET) 438 : IF (IRET.NE.0) GOTO 9999 439 : IF (LRACOU) THEN 440 : SEGACT MATRIK*MOD 441 : MATRIK.KKMMT(4)=NORMP 442 : MATRIK.KKMMT(5)=NORMD 443 : SEGDES MATRIK 444 : ENDIF 445 : ENDIF 446 : C 447 : C Transformation du vecteur-solution en chpoint 448 : C 448 : CALL XDISP(MATRIK,INCX,MCHSOL,IMPR,IRET) 449 : IF (IRET.NE.0) GOTO 9999 450 : C 451 : C Suppression des objets temporaires 452 : C 453 : IF (LRACOU) THEN 454 : SEGACT MATRIK*MOD 455 : MATRIK.KIDMAT(4)=AMORS 456 : MATRIK.KIDMAT(5)=AISA 457 : SEGDES MATRIK 458 : ELSE 459 : SEGSUP,AMORS 460 : SEGSUP,AISA 461 : ENDIF 462 : SEGSUP INCX 463 : SEGSUP KS2B 464 : * 465 : * Normal termination 466 : * 467 : IRET=0 468 : RETURN 469 : * 470 : * Format handling 471 : * 472 : * 473 : * Error handling 474 : * 475 : 9999 CONTINUE 476 : IRET=1 477 : WRITE(IOIMP,*) 'An error was detected in kres5.eso' 478 : RETURN 479 : * 480 : * End of KRES5 481 : * 482 : END 483 : 484 : 485 : 486 : 487 : 488 : 489 : 490 : 491 : 492 : 493 : 494 : 495 : 496 : 497 : 498 : 499 : 500 : 501 : 502 :
© Cast3M 2003 - All rights reserved.
Disclaimer