1 : C KRES11 SOURCE GOUNAND 11/10/07 21:15:50 7149 2 : SUBROUTINE KRES11(KMORS,KIZA,KTYP,ISMBR, 3 : $ KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC, 4 : $ KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV, 5 : $ KTIME,LTIME, 6 : $ INCX,LRES,LNMV,ICVG,IMPR,INODET) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : IMPLICIT INTEGER (I-N) 9 : C*********************************************************************** 10 : C NOM : KRES11 11 : C DESCRIPTION : - Construction du préconditionneur 12 : C - Appel des solveurs itératifs 13 : C 14 : C 15 : C LANGAGE : ESOPE 16 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 17 : C mél : gounand@semt2.smts.cea.fr 18 : C*********************************************************************** 19 : C VERSION : v1, 29/08/2011, version initiale 20 : C HISTORIQUE : v1, 29/08/2011, création 21 : C HISTORIQUE : 22 : C HISTORIQUE : 23 : C*********************************************************************** 24 : -INC CCOPTIO 25 : -INC SMLENTI 26 : POINTEUR LNMV.MLENTI 27 : POINTEUR ATYP.MLENTI 28 : -INC SMLREEL 29 : POINTEUR LRES.MLREEL 30 : -INC SMMATRIK 31 : POINTEUR MAPREC.MATRIK 32 : POINTEUR AMORS.PMORS 33 : POINTEUR AISA.IZA 34 : -INC SMVECTD 35 : POINTEUR ISMBR.MVECTD 36 : POINTEUR INCX.MVECTD 37 : C Tableau de correspondance : entier <-> mot 38 : C pour le type d'inversion 39 : INTEGER NBTYPI,LNTYPI 40 : PARAMETER (NBTYPI=16) 41 : PARAMETER (LNTYPI=18) 42 : CHARACTER*(LNTYPI) LTYPI(NBTYPI) 43 : C Tableau de correspondance : entier <-> mot 44 : C pour le type de préconditionnement (cas d'une méthode itérative) 45 : INTEGER NBPREC,LNPREC 46 : PARAMETER (NBPREC=11) 47 : PARAMETER (LNPREC=8) 48 : CHARACTER*(LNPREC) LPREC(NBPREC) 49 : -INC SMTABLE 50 : POINTEUR KTIME.MTABLE 51 : DIMENSION ITTIME(6) 52 : CHARACTER*8 CHARI 53 : CHARACTER*1 CCOMP 54 : LOGICAL LTIME 55 : C 56 : C Initialisation des tableaux 57 : C 58 : DATA LTYPI/'Choleski ', 59 : $ 'Conjugate Gradient', 60 : $ 'BiCGSTAB G ', 61 : $ 'BiCGSTAB(l) G ', 62 : $ 'GMRES(m) ', 63 : $ 'CGS-Neumaier ', 64 : $ 'Multigrid FCG ', 65 : $ 'Multigrid GCR(m) ', 66 : $ 'Bi-CG ', 67 : $ 'CG old ', 68 : $ 'BiCGSTAB old ', 69 : $ 'GMRES(m) old ', 70 : $ 'CGS ', 71 : $ 'BiCGSTAB ', 72 : $ 'BiCGSTAB(l) ', 73 : $ 'BiCGSTAB(l)F '/ 74 : DATA LPREC/'None ', 75 : $ 'Jacobi ', 76 : $ 'D-ILU ', 77 : $ 'ILU(0) ', 78 : $ 'MILU(0) ', 79 : $ 'ILUT ', 80 : $ 'ILUT2 ', 81 : $ 'ILUTP ', 82 : $ 'ILUTP+0 ', 83 : $ 'ILU0-PV ', 84 : $ 'ILU0-PVf'/ 85 : * 86 : * Executable statements 87 : * 88 : * WRITE(IOIMP,*) 'Entrée dans kres10.eso' 89 : ICVG=0 90 : *Debug IF (KTYPI.EQ.1) KTYPI=3 91 : IF (KTYPI.LT.2.OR.KTYPI.GT.NBTYPI) THEN 92 : WRITE(IOIMP,*) 'KTYPI incorrect (2..',NBTYPI,') :',KTYPI 93 : GOTO 9999 94 : ENDIF 95 : IF (KPREC.LT.0.OR.KPREC.GT.NBPREC-1) THEN 96 : WRITE(IOIMP,*) 'PRECOND ', 97 : $ 'incorrect (0..',NBPREC-1,') :',KPREC 98 : GOTO 9999 99 : ENDIF 100 : C 101 : C Impressions 102 : C 103 : IF (IMPR.GT.1) THEN 104 : IF (IDDOT.EQ.0) CCOMP=' ' 105 : IF (IDDOT.EQ.1) CCOMP='c' 106 : IF (KTYPI.EQ.5.OR.KTYPI.EQ.8) THEN 107 : WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (m=',IRSTRT,')' 108 : ELSEIF (KTYPI.EQ.11.OR.KTYPI.EQ.12) THEN 109 : WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI),' (l=',LBCG,')' 110 : ELSE 111 : WRITE(IOIMP,*) CCOMP,LTYPI(KTYPI) 112 : ENDIF 113 : IF (KPREC.EQ.4) THEN 114 : WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXMILU,')' 115 : 110 FORMAT (3A,D9.2,A) 116 : ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN 117 : WRITE(IOIMP,111) ' ',LPREC(KPREC+1),' (lfil=',XLFIL, 118 : $ ' droptol=',XDTOL,')' 119 : 111 FORMAT (3A,D9.2,A,D9.2,A) 120 : ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN 121 : WRITE(IOIMP,112) ' ',LPREC(KPREC+1),' (lfil=',XLFIL, 122 : $ ' droptol=',XDTOL,' pivtol=',XSPIV, 123 : $ ')' 124 : 112 FORMAT (3A,D9.2,A,D9.2,A,D9.2,A,I4,A) 125 : ELSEIF (KPREC.EQ.10) THEN 126 : WRITE(IOIMP,110) ' ',LPREC(KPREC+1),' (r=',RXILUP,')' 127 : ELSE 128 : WRITE(IOIMP,*) LPREC(KPREC+1) 129 : ENDIF 130 : ENDIF 131 : IF (LTIME) THEN 131 : CALL TIMESPV(ITTIME) 132 : ITI1=(ITTIME(1)+ITTIME(2)) 133 : ENDIF 134 : C 135 : C - Construction du préconditionneur (repris sur kres5) 136 : C 137 : SEGACT ISMBR 138 : INC=ISMBR.VECTBB(/1) 139 : NRIGE=0 140 : NMATRI=0 141 : NKID=9 142 : NKMT=7 143 : SEGINI MAPREC 144 : MAPREC.KNTTT=INC 145 : MAPREC.KSYM=2 146 : NTT=0 147 : NPT=0 148 : NBLK=0 149 : SEGINI IDMAT 150 : MAPREC.KIDMAT(1)=IDMAT 151 : * 152 : IF (KPREC.EQ.1) THEN 152 : CALL MEIDIA(KMORS,KIZA,MAPREC,IMPR,IRET) 153 : IF (IRET.NE.0) GOTO 9999 154 : ELSEIF (KPREC.EQ.2) THEN 154 : CALL PRDILU(KMORS,KIZA,MAPREC,IMPR,IRET) 155 : IF (IRET.NE.0) GOTO 9999 156 : ELSEIF (KPREC.EQ.3) THEN 156 : CALL PRILU0(KMORS,KIZA,MAPREC,IMPR,IRET) 157 : IF (IRET.NE.0) GOTO 9999 158 : ELSEIF (KPREC.EQ.4) THEN 158 : CALL PRMILU(KMORS,KIZA,MAPREC,RXMILU,IMPR,IRET) 159 : IF (IRET.NE.0) GOTO 9999 160 : ELSEIF (KPREC.GE.5.AND.KPREC.LE.6) THEN 161 : IVARI=KPREC-5 161 : CALL PRILUT(KMORS,KIZA,MAPREC,XLFIL,XDTOL,IVARI, 162 : $ IMPR,IRET) 163 : IF (IRET.NE.0) GOTO 9999 164 : * WRITE(IOIMP,*) 'PRILUT !' 165 : * ELSEIF (KPREC.GE.7.AND.KPREC.LE.9) THEN 166 : ELSEIF (KPREC.GE.7.AND.KPREC.LE.8) THEN 167 : WRITE(IOIMP,*) 'KPREC=',KPREC, 'non dispo' 168 : GOTO 9999 169 : ELSEIF (KPREC.EQ.9.OR.KPREC.EQ.10) THEN 169 : CALL PRILUP(KMORS,KIZA,MAPREC,RXILUP,KPREC-9,IMPR,IRET) 170 : IF (IRET.NE.0) GOTO 9999 171 : ELSEIF (KPREC.NE.0) THEN 172 : WRITE(IOIMP,*) 'Erreur de programmation' 173 : GOTO 9999 174 : ENDIF 175 : IF (LTIME) THEN 175 : CALL TIMESPV(ITTIME) 176 : ITI2=(ITTIME(1)+ITTIME(2)) 177 : ENDIF 178 : C MATRIK=MAPREC 179 : C SEGACT MATRIK 180 : C nkid=kidmat(/1) 181 : C WRITE(IOIMP,*) 'Apres constr precon' 182 : C WRITE(IOIMP,*) ' MAPREC KIDMAT NKID=',nkid 183 : C WRITE(IOIMP,2020) (KIDMAT(II),II=1,KIDMAT(/1)) 184 : C 2020 FORMAT (20(2X,I12) ) 185 : C 186 : C - Appel des solveurs itératifs 187 : C Apparemment, le segment MATRIK ne sert qu'à vérifier la symétrie 188 : C et à construire INCTYP pour le multigrille 189 : C 190 : NRIGE=0 191 : NMATRI=0 192 : NKID=0 193 : NKMT=0 194 : SEGINI MATRIK 195 : IF (KTYPI.NE.2) KSYM=2 196 : SEGACT ISMBR 197 : INC=ISMBR.VECTBB(/1) 198 : SEGINI INCX 199 : KS2B=ISMBR 200 : AMORS=KMORS 201 : AISA=KIZA 202 : ATYP=KTYP 203 : * 204 : IF (KTYPI.EQ.2) THEN 204 : CALL PRCG2(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 205 : $ ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC, 206 : $ IMPR,IRET) 207 : ELSEIF (KTYPI.EQ.3) THEN 208 : LBCG=1 208 : CALL PRBCGG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 209 : $ ITER,INMV,RESID,KPREC,BRTOL,LBCG,ICALRS,IDDOT,IMVEC, 210 : $ IMPR,IRET) 211 : ELSEIF (KTYPI.EQ.4) THEN 211 : CALL PRBCGG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 212 : $ ITER,INMV,RESID,KPREC,BRTOL,LBCG,ICALRS,IDDOT,IMVEC, 213 : $ IMPR,IRET) 214 : ELSEIF (KTYPI.EQ.5) THEN 215 : C WRITE(IOIMP,*) 'ITER=',ITER 216 : C WRITE(IOIMP,*) 'INMV=',INMV 217 : C WRITE(IOIMP,*) 'RESID=',RESID 218 : C WRITE(IOIMP,*) 'KPREC=',KPREC 219 : C WRITE(IOIMP,*) 'IRSTRT=',IRSTRT 220 : C WRITE(IOIMP,*) 'ICALRS=',ICALRS 221 : C WRITE(IOIMP,*) 'IDDOT=',IDDOT 221 : CALL PRGMR2(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 222 : $ ITER,INMV,RESID,KPREC,IRSTRT,ICALRS,IDDOT,IMVEC, 223 : $ IMPR,IRET) 224 : ELSEIF (KTYPI.EQ.6) THEN 224 : CALL PRCGSN(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 225 : $ ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC, 226 : $ IMPR,IRET) 227 : ELSEIF (KTYPI.EQ.7) THEN 228 : * WRITE(IOIMP,*) 'Appel de pragmg' 228 : CALL PRAGMG(AMORS,ATYP,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV, 229 : $ INCX, 230 : $ ITER,INMV,RESID,KPREC,1,ICALRS,IDDOT,IMVEC,KTIME,LTIME, 231 : $ IMPR,IRET) 232 : SEGSUP ATYP 233 : ELSEIF (KTYPI.EQ.8) THEN 233 : CALL PRAGMG(AMORS,ATYP,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV, 234 : $ INCX, 235 : $ ITER,INMV,RESID,KPREC,IRSTRT,ICALRS,IDDOT,IMVEC,KTIME, 236 : $ LTIME, 237 : $ IMPR,IRET) 238 : SEGSUP ATYP 239 : ELSEIF (KTYPI.EQ.9) THEN 239 : CALL PRBCG(AMORS,AISA,KS2B,MATRIK,MAPREC,LRES,LNMV,INCX, 240 : $ ITER,INMV,RESID,KPREC,BRTOL,ICALRS,IDDOT,IMVEC, 241 : $ IMPR,IRET) 242 : ELSE 243 : WRITE(IOIMP,*) 'KTYPI=',KTYPI,' invalide (1..',NBTYPI,')' 244 : GOTO 9999 245 : ENDIF 246 : C IRET<0 : 'vrai erreur' ou breakdown (dans le cas de BiCGSTAB) 247 : C IRET>0 : l'itération n'a pas convergé mais on veut 248 : C quand meme la solution calculée 249 : ICVG=IRET 250 : IF (IRET.GT.0) THEN 251 : WRITE(IOIMP,*) 'Convergence to tolerance not achieved : ', 252 : $ 'ITER=',ITER,' INMV=',INMV,' RESID=',RESID 253 : ELSEIF (IRET.EQ.0) THEN 254 : IF (IMPR.GT.0) THEN 255 : WRITE(IOIMP,*) 'ITER=',ITER,' INMV=',INMV,' RESID=',RESID 256 : ENDIF 257 : ELSEIF (IRET.LT.0) THEN 258 : WRITE(IOIMP,*) 'Error or breakdown in iterative method' 259 : GOTO 9999 260 : ELSE 261 : WRITE(IOIMP,*) 'KTYPI=',KTYPI,' invalide (1..',NBTYPI,')' 262 : GOTO 9999 263 : ENDIF 264 : SEGSUP MATRIK 265 : IF (LTIME) THEN 265 : CALL TIMESPV(ITTIME) 266 : ITI3=(ITTIME(1)+ITTIME(2)) 267 : ITP=ITI2-ITI1 268 : ITR=ITI3-ITI2 269 : CHARI='PRECONDI' 269 : CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI, 270 : $ 'ENTIER ',ITP,XVALR,CHARR,LOGIR,IRETR) 271 : CHARI='RESOLUTI' 271 : CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI, 272 : $ 'ENTIER ',ITR,XVALR,CHARR,LOGIR,IRETR) 273 : ENDIF 274 : C 275 : C Destruction du préconditionneur 276 : C 277 : SEGACT MAPREC 278 : IDMAT=MAPREC.KIDMAT(1) 279 : IF (IDMAT.NE.0) THEN 280 : SEGACT IDMAT 281 : IZA=IDIAG 282 : SEGSUP IZA 283 : SEGSUP IDMAT 284 : ENDIF 285 : PMORS=MAPREC.KIDMAT(6) 286 : IF (PMORS.NE.0) SEGSUP PMORS 287 : IZA=MAPREC.KIDMAT(7) 288 : IF (IZA.NE.0) SEGSUP IZA 289 : SEGSUP MAPREC 290 : C 291 : C Destruction de la matrice Morse 292 : C 293 : IF (INODET.EQ.0) THEN 294 : SEGSUP AMORS 295 : SEGSUP AISA 296 : ENDIF 297 : * 298 : * Normal termination 299 : * 300 : RETURN 301 : * 302 : * Format handling 303 : * 304 : * 305 : * Error handling 306 : * 307 : 9999 CONTINUE 308 : MOTERR(1:8)='KRES11 ' 308 : CALL ERREUR(349) 309 : RETURN 310 : * 311 : * End of subroutine KRES11 312 : * 313 : END 314 : 315 :
© Cast3M 2003 - All rights reserved.
Disclaimer