1 : C PRKRES SOURCE GOUNAND 11/10/07 21:16:10 7149 2 : SUBROUTINE PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS, 3 : $ MAPREC, 4 : $ MRENU,MMULAG,ISCAL,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL, 5 : $ IRSTRT,KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,LBCG,ICALRS, 6 : $ METASS,LTIME,LDEPE,MRIGID,IDDOT,IMVEC,IRET) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : IMPLICIT INTEGER (I-N) 9 : C*********************************************************************** 10 : C NOM : PRKRES 11 : C DESCRIPTION : 12 : C Lecture des arguments et mise à défaut des optionnels () 13 : C 14 : C MATRIK : La matrice lue en entrée au format MATRIK 15 : C MTINV : L'éventuelle table d'inversion (obsolète) 16 : C IMPR : Niveau d'impression solveur direct 17 : C KCLIM : Chpoint éventuel de conditions aux limites de Dirichlet 18 : C KSMBR : Chpoint second membre 19 : C KTYPI : Type de méthode de résolution 20 : C MATASS : Matrice utilisée pour préconditionner l'assemblage 21 : C MAPREC : Matrice utilisée pour préconditionner la construction du 22 : C préconditionneur 23 : C MRENU : Type de renumérotation 24 : C MMULAG : Placement des multiplicateurs de Lagrange 25 : C ISCAL : Scaling de la matrice 26 : C IOUBL : Oubli des matrices élémentaires ? 27 : C IMPINV : Niveau d'impression solveur itératif 28 : C MCHINI : Chpoint estimation de l'inconnue 29 : C ITER : Nombre maxi d'itérations à effectuer 30 : C RESID : Norme L2 maxi du résidu 31 : C BRTOL : Breakdown tolerance pour les méthodes de type Bi-CG 32 : C IRSTRT : Paramètre m de redémarrage pour GMRES 33 : C KPREC : Type du préconditionneur 34 : C RXMILU : Paramètre de relaxation pour MILU(0) 35 : C RXILUP : Paramètre de filtre pour ILU(0)-PV 36 : C XLFIL : Paramètre de remplissage pour les préconditionneurs ILUT 37 : C XDTOL : Drop tolerance pour les préconditionneurs ILUT 38 : C XSPIV : Sensibilité du pivoting pour les préconditionneurs ILUTP 39 : C LBCG : le l dans BicgStab(l) 40 : C ICALRS : façon de calculer le résidu 41 : C METASS : méthode d'assemblage 42 : C LTIME : construit une table avec des statistiques temporelles 43 : C si vrai 44 : C LDEPE : élimine les dépendances si VRAI 45 : C et matrice d'entrée RIGIDITE 46 : C IDDOT : 0 => utilisation du produit scalaire normal dans les 47 : C méthodes itératives 48 : C 1 => utilisation du produit scalaire compensé 49 : C IMVEC : 0, pas de parallélisme pour les produits matrice-vecteur 50 : C 1, parallélisme stratégie 1, entrelace les lignes. 51 : C 2, parallélisme stratégie 2, groupe les lignes. 52 : C Par defaut : 2 53 : C 54 : C LANGAGE : ESOPE 55 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 56 : C mél : gounand@semt2.smts.cea.fr 57 : C*********************************************************************** 58 : C APPELES : 59 : C APPELES (E/S) : 60 : C APPELES (BLAS) : 61 : C APPELES (CALCUL) : 62 : C APPELE PAR : 63 : C*********************************************************************** 64 : C SYNTAXE GIBIANE : 65 : C ENTREES : 66 : C ENTREES/SORTIES : 67 : C SORTIES : 68 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 69 : C*********************************************************************** 70 : C VERSION : v1, 22/02/2006, version initiale 71 : C HISTORIQUE : v1, 22/02/2006, création 72 : C HISTORIQUE : 73 : C HISTORIQUE : 74 : C*********************************************************************** 75 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 76 : C en cas de modification de ce sous-programme afin de faciliter 77 : C la maintenance ! 78 : C*********************************************************************** 79 : -INC CCREEL 80 : -INC CCOPTIO 81 : -INC SMCHPOI 82 : POINTEUR KCLIM.MCHPOI 83 : POINTEUR KSMBR.MCHPOI 84 : POINTEUR MCHINI.MCHPOI 85 : POINTEUR MCHSOL.MCHPOI 86 : -INC SMTABLE 87 : POINTEUR MTINV.MTABLE 88 : *-INC SMMATRIK 89 : * POINTEUR MAPREC.MATRIK 90 : * POINTEUR MATASS.MATRIK 91 : -INC SMRIGID 92 : -INC SMELEME 93 : * 94 : INTEGER KTYPI,ISCAL,IOUBL,IMPINV,ITER,IRSTRT,KPREC 95 : REAL*8 RESID,BRTOL,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV 96 : CHARACTER*4 MRENU,MMULAG 97 : * 98 : CHARACTER*8 TYPI,TYPR,TYP2,BLAN,TYPE,MTYP 99 : CHARACTER*8 TYTABL,TYLMOT,TYCHPO,TYMOT,TYENT,TYFLO,TYLENT 100 : CHARACTER*8 TYMATK,TYRIGI,INDTAB,TYLOG 101 : * 102 : INTEGER IBID,IVAL,IOBJ 103 : REAL*8 XBID,XVAL 104 : CHARACTER*4 CBID,CVAL 105 : LOGICAL LBID,LVAL,LTIME,LMRENU,LMETAS,LDEPE,LLDEPE 106 : LOGICAL LMUANO,LNORMA 107 : * 108 : INTEGER IMPR,IRET 109 : PARAMETER (NMOT=30) 110 : CHARACTER*8 MOTSCL(NMOT),TYARG(NMOT) 110 : C CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC, 111 : C $ MRENU,MMULAG,ISCAL,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL, 112 : C $ IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,IMPR,IRET) 113 : DATA MOTSCL/ 114 : $ 'IMPR ','TYPI ','CLIM ','SMBR ','TYPINV ', 115 : $ 'MATASS ','MAPREC ','TYRENU ','PCMLAG ','SCALING ', 116 : $ 'OUBMAT ','IMPINV ','XINIT ','NITMAX ','RESID ', 117 : $ 'BCGSBTOL','GMRESTRT','PRECOND ','MILURELX','ILUTLFIL', 118 : $ 'ILUTDTOL','ILUTPPIV','LBCG ','CALRES ','METASS ', 119 : $ 'LTIME ','LDEPE ','ILUPRELX','IDDOT ','IMVEC '/ 120 : DATA TYARG/ 121 : $ 'ENTIER ','TABLE ','CHPOINT ','CHPOINT ','ENTIER ', 122 : $ 'MATRIK ','MATRIK ','MOT ','MOT ','ENTIER ', 123 : $ 'ENTIER ','ENTIER ','CHPOINT ','ENTIER ','FLOTTANT', 124 : $ 'FLOTTANT','ENTIER ','ENTIER ','FLOTTANT','FLOTTANT', 125 : $ 'FLOTTANT','FLOTTANT','ENTIER ','ENTIER ','ENTIER ', 126 : $ 'LOGIQUE ','LOGIQUE ','FLOTTANT','ENTIER ','ENTIER '/ 127 : DATA TYTABL,TYCHPO,TYMOT,TYENT,TYFLO,TYMATK,TYRIGI,BLAN,TYLOG/ 128 : $ 'TABLE ','CHPOINT ','MOT ','ENTIER ','FLOTTANT', 129 : $ 'MATRIK ','RIGIDITE',' ','LOGIQUE ' 130 : $ / 131 : * 132 : * Executable statements 133 : * 134 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prkres.eso' 135 : * 136 : * Lecture de la matrice 137 : * 138 : TYPE=BLAN 138 : CALL QUETYP(TYPE,1,IRET) 139 : IF (IRET.EQ.0) GOTO 9999 140 : IF (TYPE.EQ.TYRIGI) THEN 141 : MATRIK=0 141 : CALL LIROBJ(TYPE,MRIGID,1,IRET) 142 : * WRITE(IOIMP,*) 'Ap MACHI2' 143 : * WRITE(IOIMP,*) 'Non implémenté' 144 : * GOTO 9999 145 : ELSE 146 : MRIGID=0 147 : TYPE=TYMATK 147 : CALL LIROBJ(TYPE,MATRIK,1,IRET) 148 : IF(IRET.EQ.0) GOTO 9999 149 : ENDIF 150 : * 151 : * Lecture du second membre éventuel 152 : * 153 : KSMBR=0 153 : CALL QUETYP(TYPE,1,IRET) 154 : IF (TYPE.EQ.TYCHPO) THEN 154 : CALL LIROBJ(TYPE,KSMBR,1,IRET) 155 : IF(IRET.EQ.0) GOTO 9999 156 : ENDIF 157 : * 158 : * Valeurs par défaut 159 : * 159 : C CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC, 160 : C $ MRENU,MMULAG,ISCAL,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL, 161 : C $ IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,LBCG,IRET) 162 : MTINV=0 163 : IMPR=0 164 : KCLIM=0 165 : KTYPI=1 166 : MATASS=MATRIK 167 : MAPREC=MATRIK 168 : MRENU='SLOA' 169 : LMRENU=.FALSE. 170 : MMULAG='APR2' 171 : ISCAL=0 172 : IF (MRIGID.NE.0) THEN 173 : IOUBL=1 174 : ELSE 175 : IOUBL=0 176 : ENDIF 177 : IMPINV=0 178 : MCHINI=0 179 : ITER=2000 180 : RESID=1.D-10 181 : BRTOL=1.D-40 182 : IRSTRT=50 183 : KPREC=3 184 : RXMILU=1.D0 185 : RXILUP=0.5D0 186 : XLFIL=2.D0 187 : XDTOL=-1.D0 188 : XSPIV=0.1D0 189 : LBCG=4 190 : ICALRS=0 191 : METASS=5 192 : LMETAS=.FALSE. 193 : LTIME=.FALSE. 194 : LDEPE=.TRUE. 195 : LLDEPE=.FALSE. 196 : IDDOT=0 197 : IMVEC=2 198 : * 199 : * Boucle de lecture des arguments 200 : * 201 : 1 CONTINUE 201 : CALL LIRMOT(MOTSCL,NMOT,IRAN,0) 202 : IF(IRAN.EQ.0) GOTO 2 203 : IF (IRAN.EQ.2) THEN 203 : CALL LIRTAB('METHINV',MTINV,1,IRET) 204 : IF (IRET.EQ.0) GOTO 9999 205 : * 206 : * Lectures des indices de table 207 : * 208 : * WRITE(IOIMP,*) 'Lecture de la table' 209 : DO I=1,NMOT 210 : TYPI=TYMOT 211 : TYPR=BLAN 212 : TYPE=TYARG(I) 213 : INDTAB=MOTSCL(I) 214 : * WRITE(IOIMP,*) 'INDTAB=',INDTAB 214 : CALL ACCTAB(MTINV,TYPI,IBID,XBID,INDTAB,LBID,IBID, 215 : $ TYPR,IVAL,XVAL,CVAL,LVAL,IOBJ) 216 : IF (IERR.NE.0) GOTO 9999 217 : IF (TYPR.NE.TYPE) THEN 218 : IF (TYPR.EQ.TYENT.AND.TYPE.EQ.TYFLO) THEN 219 : XVAL=IVAL 220 : ELSEIF (TYPR.NE.BLAN) THEN 221 : WRITE(IOIMP,*) 'Index ',INDTAB,' : ',TYPR, 222 : $ ' type object instead of ',TYPE 223 : GOTO 9999 224 : ENDIF 225 : ENDIF 226 : IF (TYPR.NE.BLAN) THEN 227 : IF (I.EQ.1) THEN 228 : IMPR=IVAL 229 : * I.EQ.2 n'a pas de sens 230 : ELSEIF (I.EQ.3) THEN 231 : KCLIM=IOBJ 232 : ELSEIF (I.EQ.4) THEN 233 : KSMBR=IOBJ 234 : ELSEIF (I.EQ.5) THEN 235 : KTYPI=IVAL 236 : ELSEIF (I.EQ.6) THEN 237 : MATASS=IOBJ 238 : ELSEIF (I.EQ.7) THEN 239 : MAPREC=IOBJ 240 : ELSEIF (I.EQ.8) THEN 241 : MRENU=CVAL 242 : LMRENU=.TRUE. 243 : ELSEIF (I.EQ.9) THEN 244 : MMULAG=CVAL 245 : ELSEIF (I.EQ.10) THEN 246 : ISCAL=IVAL 247 : ELSEIF (I.EQ.11) THEN 248 : IOUBL=IVAL 249 : ELSEIF (I.EQ.12) THEN 250 : IMPINV=IVAL 251 : ELSEIF (I.EQ.13) THEN 252 : MCHINI=IOBJ 253 : ELSEIF (I.EQ.14) THEN 254 : ITER=IVAL 255 : ELSEIF (I.EQ.15) THEN 256 : RESID=XVAL 257 : ELSEIF (I.EQ.16) THEN 258 : BRTOL=XVAL 259 : ELSEIF (I.EQ.17) THEN 260 : IRSTRT=IVAL 261 : ELSEIF (I.EQ.18) THEN 262 : KPREC=IVAL 263 : ELSEIF (I.EQ.19) THEN 264 : RXMILU=XVAL 265 : ELSEIF (I.EQ.20) THEN 266 : XLFIL=XVAL 267 : ELSEIF (I.EQ.21) THEN 268 : XDTOL=XVAL 269 : ELSEIF (I.EQ.22) THEN 270 : XSPIV=XVAL 271 : ELSEIF (I.EQ.23) THEN 272 : LBCG=IVAL 273 : ELSEIF (I.EQ.24) THEN 274 : ICALRS=IVAL 275 : ELSEIF (I.EQ.25) THEN 276 : METASS=IVAL 277 : LMETAS=.TRUE. 278 : ELSEIF (I.EQ.26) THEN 279 : LTIME=LVAL 280 : ELSEIF (I.EQ.27) THEN 281 : LDEPE=LVAL 282 : ELSEIF (I.EQ.28) THEN 283 : RXILUP=XVAL 284 : ELSEIF (I.EQ.29) THEN 285 : IDDOT=IVAL 286 : ELSEIF (I.EQ.30) THEN 287 : IMVEC=IVAL 288 : ELSE 289 : WRITE(IOIMP,*) 'Programing error' 289 : CALL ERREUR(5) 290 : GOTO 9999 291 : ENDIF 292 : ENDIF 293 : ENDDO 294 : ELSE 295 : TYPE=TYARG(IRAN) 296 : IF (TYPE.EQ.TYENT) THEN 296 : CALL LIRENT(IVAL,1,IRET) 297 : ELSEIF (TYPE.EQ.TYFLO) THEN 297 : CALL LIRREE(XVAL,1,IRET) 298 : ELSEIF (TYPE.EQ.TYMOT) THEN 298 : CALL LIRCHA(CVAL,1,IRET) 299 : ELSEIF (TYPE.EQ.TYLOG) THEN 299 : CALL LIRLOG(LVAL,1,IRET) 300 : ELSE 300 : CALL LIROBJ(TYPE,IOBJ,1,IRET) 301 : ENDIF 302 : IF (IRET.EQ.0) GOTO 9999 303 : IF (IRAN.EQ.1) THEN 304 : IMPR=IVAL 305 : * I.EQ.2 n'a pas de sens 306 : ELSEIF (IRAN.EQ.3) THEN 307 : KCLIM=IOBJ 308 : ELSEIF (IRAN.EQ.4) THEN 309 : KSMBR=IOBJ 310 : ELSEIF (IRAN.EQ.5) THEN 311 : KTYPI=IVAL 312 : ELSEIF (IRAN.EQ.6) THEN 313 : MATASS=IOBJ 314 : ELSEIF (IRAN.EQ.7) THEN 315 : MAPREC=IOBJ 316 : ELSEIF (IRAN.EQ.8) THEN 317 : MRENU=CVAL 318 : LMRENU=.TRUE. 319 : ELSEIF (IRAN.EQ.9) THEN 320 : MMULAG=CVAL 321 : ELSEIF (IRAN.EQ.10) THEN 322 : ISCAL=IVAL 323 : ELSEIF (IRAN.EQ.11) THEN 324 : IOUBL=IVAL 325 : ELSEIF (IRAN.EQ.12) THEN 326 : IMPINV=IVAL 327 : ELSEIF (IRAN.EQ.13) THEN 328 : MCHINI=IOBJ 329 : ELSEIF (IRAN.EQ.14) THEN 330 : ITER=IVAL 331 : ELSEIF (IRAN.EQ.15) THEN 332 : RESID=XVAL 333 : ELSEIF (IRAN.EQ.16) THEN 334 : BRTOL=XVAL 335 : ELSEIF (IRAN.EQ.17) THEN 336 : IRSTRT=IVAL 337 : ELSEIF (IRAN.EQ.18) THEN 338 : KPREC=IVAL 339 : ELSEIF (IRAN.EQ.19) THEN 340 : RXMILU=XVAL 341 : ELSEIF (IRAN.EQ.20) THEN 342 : XLFIL=XVAL 343 : ELSEIF (IRAN.EQ.21) THEN 344 : XDTOL=XVAL 345 : ELSEIF (IRAN.EQ.22) THEN 346 : XSPIV=XVAL 347 : ELSEIF (IRAN.EQ.23) THEN 348 : LBCG=IVAL 349 : ELSEIF (IRAN.EQ.24) THEN 350 : ICALRS=IVAL 351 : ELSEIF (IRAN.EQ.25) THEN 352 : METASS=IVAL 353 : LMETAS=.TRUE. 354 : ELSEIF (IRAN.EQ.26) THEN 355 : LTIME=LVAL 356 : ELSEIF (IRAN.EQ.27) THEN 357 : LDEPE=LVAL 358 : LLDEPE=.TRUE. 359 : ELSEIF (IRAN.EQ.28) THEN 360 : RXILUP=XVAL 361 : ELSEIF (IRAN.EQ.29) THEN 362 : IDDOT=IVAL 363 : ELSEIF (IRAN.EQ.29) THEN 364 : IMVEC=IVAL 365 : ELSE 366 : WRITE(IOIMP,*) 'Programing error 2' 366 : CALL ERREUR(5) 367 : GOTO 9999 368 : ENDIF 369 : ENDIF 370 : GOTO 1 371 : * 372 : * Fin des lectures 373 : * 374 : 2 CONTINUE 375 : C MTYP=TYMATK 375 : C CALL ECRENT(6) 375 : C CALL ECROBJ(MTYP,MATRIK) 375 : C CALL PRLIST 376 : C MTYP=TYCHPO 376 : C CALL ECROBJ(MTYP,KSMBR) 376 : C CALL PRLIST 377 : * 378 : * Vérification de la validité de certains paramètres 379 : * 379 : C CALL PRKRES(MATRIK,MTINV,IMPR,KCLIM,KSMBR,KTYPI,MATASS,MAPREC, 380 : C $ MRENU,MMULAG,ISCAL,IOUBL,IMPINV,MCHINI,ITER,RESID,BRTOL, 381 : C $ IRSTRT,KPREC,RXMILU,XLFIL,XDTOL,XSPIV,LBCG,IRET) 382 : C 41 2 383 : C %m1:8 = %r1 inférieur à %r2 384 : C 42 2 385 : C %m1:8 = %r1 non compris entre %r2 et %r3 386 : C 43 2 387 : C %m1:8 = %r1 supérieur à %r2 388 : IINF=0 389 : ISUP=2 390 : IF (ISCAL.LT.IINF.OR.ISCAL.GT.ISUP) THEN 391 : MOTERR(1:8)=MOTSCL(10) 392 : REAERR(1)=ISCAL 393 : REAERR(2)=IINF 394 : REAERR(3)=ISUP 394 : CALL ERREUR(42) 395 : GOTO 9999 396 : ENDIF 397 : IINF=0 398 : ISUP=22 399 : IF (IOUBL.LT.IINF.OR.IOUBL.GT.ISUP) THEN 400 : MOTERR(1:8)=MOTSCL(11) 401 : REAERR(1)=IOUBL 402 : REAERR(2)=IINF 403 : REAERR(3)=ISUP 403 : CALL ERREUR(42) 404 : GOTO 9999 405 : ENDIF 406 : IINF=0 407 : IF (ITER.LT.IINF) THEN 408 : MOTERR(1:8)=MOTSCL(14) 409 : REAERR(1)=ITER 410 : REAERR(2)=IINF 410 : CALL ERREUR(41) 411 : GOTO 9999 412 : ENDIF 413 : XINF=XZERO 414 : IF (RESID.LT.XINF-XZPREC) THEN 415 : MOTERR(1:8)=MOTSCL(15) 416 : REAERR(1)=REAL(RESID) 417 : REAERR(2)=REAL(XINF) 417 : CALL ERREUR(41) 418 : GOTO 9999 419 : ENDIF 420 : XINF=XZERO 421 : IF (BRTOL.LT.XINF-XZPREC) THEN 422 : MOTERR(1:8)=MOTSCL(16) 423 : REAERR(1)=REAL(BRTOL) 424 : REAERR(2)=REAL(XINF) 424 : CALL ERREUR(41) 425 : GOTO 9999 426 : ENDIF 427 : IINF=1 428 : IF (IRSTRT.LT.IINF) THEN 429 : MOTERR(1:8)=MOTSCL(17) 430 : REAERR(1)=IRSTRT 431 : REAERR(2)=IINF 431 : CALL ERREUR(41) 432 : GOTO 9999 433 : ENDIF 434 : XINF=XZERO 435 : XSUP=1.D0 436 : IF (RXMILU.LT.XINF-XZPREC.OR.RXMILU.GT.XSUP+XZPREC) THEN 437 : MOTERR(1:8)=MOTSCL(19) 438 : REAERR(1)=REAL(RXMILU) 439 : REAERR(2)=REAL(XINF) 440 : REAERR(3)=REAL(XSUP) 440 : CALL ERREUR(42) 441 : GOTO 9999 442 : ENDIF 443 : XINF=XZERO 444 : IF (XLFIL.LT.XINF-XZPREC) THEN 445 : MOTERR(1:8)=MOTSCL(20) 446 : REAERR(1)=REAL(XLFIL) 447 : REAERR(2)=REAL(XINF) 447 : CALL ERREUR(41) 448 : GOTO 9999 449 : ENDIF 450 : XSUP=XZERO 451 : IF (XDTOL.GT.XSUP+XZPREC) THEN 452 : MOTERR(1:8)=MOTSCL(21) 453 : REAERR(1)=REAL(XDTOL) 454 : REAERR(2)=REAL(XSUP) 454 : CALL ERREUR(43) 455 : GOTO 9999 456 : ENDIF 457 : XINF=XZERO 458 : XSUP=1.D0 459 : IF (XSPIV.LT.XINF-XZPREC.OR.XSPIV.GT.XSUP+XZPREC) THEN 460 : MOTERR(1:8)=MOTSCL(22) 461 : REAERR(1)=REAL(XSPIV) 462 : REAERR(2)=REAL(XINF) 463 : REAERR(3)=REAL(XSUP) 463 : CALL ERREUR(42) 464 : GOTO 9999 465 : ENDIF 466 : IINF=1 467 : IF (LBCG.LT.IINF) THEN 468 : MOTERR(1:8)=MOTSCL(23) 469 : REAERR(1)=LBCG 470 : REAERR(2)=IINF 470 : CALL ERREUR(41) 471 : GOTO 9999 472 : ENDIF 473 : IINF=0 474 : ISUP=1 475 : IF (ICALRS.LT.IINF.OR.ICALRS.GT.ISUP) THEN 476 : MOTERR(1:8)=MOTSCL(24) 477 : REAERR(1)=ICALRS 478 : REAERR(2)=IINF 479 : REAERR(3)=ISUP 479 : CALL ERREUR(42) 480 : GOTO 9999 481 : ENDIF 482 : IINF=1 483 : ISUP=6 484 : IF (METASS.LT.IINF.OR.METASS.GT.ISUP) THEN 485 : MOTERR(1:8)=MOTSCL(25) 486 : REAERR(1)=METASS 487 : REAERR(2)=IINF 488 : REAERR(3)=ISUP 488 : CALL ERREUR(42) 489 : GOTO 9999 490 : ENDIF 491 : C XINF=XZERO 492 : C IF (RXILUP.LT.XINF-XZPREC) THEN 493 : C MOTERR(1:8)=MOTSCL(28) 494 : C REAERR(1)=RXILUP 495 : C REAERR(2)=XINF 495 : C CALL ERREUR(41) 496 : C GOTO 9999 497 : C ENDIF 498 : IINF=0 499 : ISUP=1 500 : IF (IDDOT.LT.IINF.OR.IDDOT.GT.ISUP) THEN 501 : MOTERR(1:8)=MOTSCL(29) 502 : REAERR(1)=IDDOT 503 : REAERR(2)=IINF 504 : REAERR(3)=ISUP 504 : CALL ERREUR(42) 505 : GOTO 9999 506 : ENDIF 507 : IINF=0 508 : ISUP=2 509 : IF (IMVEC.LT.IINF.OR.IMVEC.GT.ISUP) THEN 510 : MOTERR(1:8)=MOTSCL(30) 511 : REAERR(1)=IMVEC 512 : REAERR(2)=IINF 513 : REAERR(3)=ISUP 513 : CALL ERREUR(42) 514 : GOTO 9999 515 : ENDIF 516 : 517 : * S'il y a eu une tentative forte de l'utilisateur de fournir ce 518 : * paramètre. 519 : IF (MRIGID.EQ.0.AND.LDEPE.AND.LLDEPE) THEN 520 : * 134 2 521 : *Pas besoin d'objet %m1:8 quand il n'y a pas d'objet %m9:16 522 : MOTERR(1:8)='LDEPE ' 523 : MOTERR(9:16)='RIGIDITE' 523 : CALL ERREUR(134) 524 : GOTO 9999 525 : ENDIF 526 : * 527 : * Quand il y a un champ de conditions aux limites donné, 528 : * il est hasardeux d'essayer d'utiliser l'élimination des 529 : * dépendances en même temps 530 : * 531 : IF (MRIGID.NE.0.AND.KCLIM.NE.0.AND.LDEPE) THEN 532 : IF (LLDEPE) THEN 533 : * 135 2 534 : *Incompatibilité entre l'objet %m1:8 et l'objet %m9:16 535 : MOTERR(1:8)='LDEPE ' 536 : MOTERR(9:16)='CLIM ' 536 : CALL ERREUR(135) 537 : GOTO 9999 538 : ELSE 539 : LDEPE=.FALSE. 540 : ENDIF 541 : 7 ENDIF 542 : * 543 : * Certaines options ne sont pas nécessaires pour le multigrille 544 : * et sont changées brutalement ici. 545 : * 546 : IF (KTYPI.EQ.7.OR.KTYPI.EQ.8) THEN 547 : KPREC=0 548 : * S'il n'y a pas eu de tentative forte de l'utilisateur de fournir ce 549 : * paramètre. 550 : IF (.NOT.LMRENU) THEN 551 : MRENU='RIEN' 552 : ENDIF 553 : ENDIF 554 : * 555 : * Lorsque la matrice entrée est une rigidité et que l'on n'a pas de 556 : * KCLIM qui a été donné, ni de préconditionneur type ILUT avec pivoting 557 : * (qui impose une modification de la numérotation non encore gérée), 558 : * on va utiliser l'assemblage de RESOU... 559 : * 560 : IF (MRIGID.NE.0.AND.KCLIM.EQ.0.AND.KPREC.NE.7.AND.KPREC.NE.8) THEN 561 : * ...s'il n'y a pas eu de tentative forte de l'utilisateur de fournir ce 562 : * paramètre...et si la matrice ne contient pas simultanément d'inconnues 563 : * normales et de multiplicateurs de Lagrange non reconnus par RESOU (la 564 : * pression) 565 : * Ceux-ci ont un nom commencant par 'LX', mais pas le type 22 pour le 566 : * maillage 567 : IF (.NOT.LMETAS) THEN 568 : LNORMA=.FALSE. 569 : LMUANO=.FALSE. 570 : SEGACT MRIGID 571 : NRIG=COERIG(/1) 572 : DO 10 IRIG=1,NRIG 573 : MELEME=IRIGEL(1,IRIG) 574 : DESCR=IRIGEL(3,IRIG) 575 : SEGACT MELEME 576 : SEGACT DESCR 577 : NLIGRP=LISINC(/2) 578 : IF (ITYPEL.NE.22) THEN 579 : DO ILIGRP=1,NLIGRP 580 : IF (LISINC(ILIGRP)(1:2).EQ.'LX') THEN 581 : LMUANO=.TRUE. 582 : ELSE 583 : LNORMA=.TRUE. 584 : ENDIF 585 : ENDDO 586 : ENDIF 587 : SEGDES MELEME 588 : SEGDES DESCR 589 : IF (LMUANO.AND.LNORMA) GOTO 20 590 : 10 CONTINUE 591 : METASS=6 592 : 20 CONTINUE 593 : SEGDES MRIGID 594 : ENDIF 595 : ENDIF 596 : * 597 : * Impressions de vérification éventuelles 598 : * 599 : IF (IMPR.GT.2) THEN 600 : WRITE(IOIMP,*) 'KRES : following data were read' 601 : WRITE(IOIMP,*) ' Objects :' 602 : WRITE(IOIMP,*) ' MATRIK=',MATRIK,' MATASS=',MATASS, 603 : $ ' MAPREC=',MAPREC,' MRIGID=',MRIGID 604 : WRITE(IOIMP,*) ' MTINV =',MTINV 605 : WRITE(IOIMP,*) ' KCLIM =',KCLIM, ' KSMBR =',KSMBR, 606 : $ ' MCHINI=',MCHINI 607 : WRITE(IOIMP,*) ' General options :' 608 : WRITE(IOIMP,*) ' KTYPI =',KTYPI, ' KPREC =',KPREC 609 : WRITE(IOIMP,*) ' MRENU =',MRENU, ' MMULAG=',MMULAG 610 : WRITE(IOIMP,*) ' ISCAL =',ISCAL, ' IOUBL =',IOUBL 611 : WRITE(IOIMP,*) ' IMPR =',IMPR, ' IMPINV=',IMPINV 612 : WRITE(IOIMP,*) ' METASS=',METASS,' LTIME =',LTIME 613 : WRITE(IOIMP,*) ' LDEPE =',LDEPE 614 : WRITE(IOIMP,*) ' Iterative methods :' 615 : WRITE(IOIMP,*) ' ITER =',ITER, ' RESID =',RESID 616 : WRITE(IOIMP,*) ' BRTOL =',BRTOL, ' IRSTRT=',IRSTRT 617 : WRITE(IOIMP,*) ' LBCG =',LBCG, ' ICALRS=',ICALRS 618 : WRITE(IOIMP,*) ' IDDOT =',IDDOT, ' IMVEC =',IMVEC 619 : WRITE(IOIMP,*) ' Preconditioners :' 620 : WRITE(IOIMP,*) ' RXMILU=',RXMILU,' XLFIL =',XLFIL 621 : WRITE(IOIMP,*) ' XDTOL =',XDTOL, ' XSPIV =',XSPIV 622 : WRITE(IOIMP,*) ' RXILUP=',RXILUP 623 : ENDIF 624 : * 625 : * Normal termination 626 : * 627 : IRET=0 628 : RETURN 629 : * 630 : * Format handling 631 : * 632 : * 633 : * Error handling 634 : * 635 : 9999 CONTINUE 636 : IRET=1 637 : WRITE(IOIMP,*) 'An error was detected in subroutine prkres' 638 : RETURN 639 : * 640 : * End of subroutine PRKRES 641 : * 642 : END 643 : 644 : 645 : 646 : 647 : 648 : 649 : 650 : 651 : 652 : 653 : 654 :
© Cast3M 2003 - All rights reserved.
Disclaimer