1 : C MEIDIA SOURCE MAGN 09/07/30 21:19:18 6458 2 : SUBROUTINE MEIDIA(KMORS,KISA,MATRIK,IMPR,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C NOM : MEIDIA 7 : C DESCRIPTION : 8 : C Calcul du préconditionneur "Jacobi" d'une matrice Morse. 9 : C Son calcul est simple : c'est la diagonale de la matrice ! 10 : C 11 : C On stocke l'inverse de la diagonale de la matrice 12 : C dans un segment de type 13 : C IZA pointé par IDIAG du segment IDMAT 14 : C pointé par KIDMAT(1) du segment MATRIK. 15 : C (Toujours la réutilisation de l'existant...) 16 : C Si on rencontre une diagonale nulle dans la matrice Morse, 17 : C on affiche un Warning et on stocke 1.D0 dans l'inverse 18 : C du préconditionneur. 19 : C De meme, on affiche un Warning si on rencontre des indices 20 : C très "petits"... 21 : C 22 : C 23 : C LANGAGE : ESOPE 24 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 25 : C mél : gounand@semt2.smts.cea.fr 26 : C*********************************************************************** 27 : C APPELES : - 28 : C*********************************************************************** 29 : C ENTREES : MATRIK, IMPR, IRET 30 : C ENTREES/SORTIES : - 31 : C SORTIES : INVPIV (IDIAG dans KIDMAT(1) dans MATRIK) 32 : C CODE RETOUR (IRET) : 0 si ok 33 : C <0 si problème 34 : C MATRIK : pointeur sur segment MATRIK de l'include SMMATRIK 35 : C on pioche dedans les informations nécessaires 36 : C (différents pointeurs, nb. de ddl...) 37 : C IMPR : niveau d'impression 38 : C INVPIV : pointeur sur segment IZA de l'include SMMATRIK 39 : C vecteur contenant l'inverse de la diagonale 40 : C de la matrice morse pointée par MATRIK (KIDMAT(4-5)) 41 : C*********************************************************************** 42 : C VERSION : v1, 01/04/98, version initiale 43 : C HISTORIQUE : v1, 01/04/98, création 44 : C HISTORIQUE : 09/02/98, on ne construit pas le préconditionneur s'il 45 : C existe déjà. 46 : C HISTORIQUE : 47 : C HISTORIQUE : 48 : C*********************************************************************** 49 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 50 : C en cas de modification de ce sous-programme afin de faciliter 51 : C la maintenance ! 52 : C*********************************************************************** 53 : -INC CCOPTIO 54 : -INC CCREEL 55 : -INC SMMATRIK 56 : POINTEUR KMORS.PMORS 57 : POINTEUR KISA.IZA 58 : POINTEUR INVPIV.IZA 59 : * 60 : * .. Variables locales 61 : * .. Parameters 62 : REAL*8 ONE ,ZERO 63 : PARAMETER (ONE=1.0D0,ZERO=0.0D0) 64 : * .. 65 : C Nombre de pivots nul 66 : INTEGER NBPIVN 67 : C Nombre de pivots petits 68 : INTEGER NBPIVP 69 : C Nombre de pivots inférieurs à 0 70 : INTEGER NBPIVI 71 : REAL*8 VALPIV 72 : C*** 73 : IRET=0 74 : IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans meidia' 75 : NBPIVP=0 76 : C On récupère les segments utiles 77 : SEGACT MATRIK 78 : NTTT =KNTTT 79 : IDMAT=KIDMAT(1) 80 : SEGACT IDMAT 81 : INVPIV=IDIAG 82 : SEGDES IDMAT 83 : SEGDES MATRIK 84 : C Le préconditionneur est-il déjà construit ? 85 : C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 86 : C En fait, on surcharge tout le temps INVPIV car IDIAG peut ne pas 87 : C etre nul mais contenir autre chose que le préconditionneur 88 : C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 89 : INVPIV=0 90 : C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 91 : IF (INVPIV.EQ.0) THEN 92 : C 93 : C On parcourt la matrice a la recherche des indices diagonaux 94 : C 95 : NBVA=NTTT 96 : SEGINI INVPIV 97 : SEGACT KMORS 98 : SEGACT KISA 99 : DO 1 INTTT=1,NTTT 100 : IDEB=KMORS.IA(INTTT) 101 : IFIN=KMORS.IA(INTTT+1)-1 102 : ICOL=IDEB 103 : IF (IDEB.LE.IFIN) THEN 104 : C On cherche le terme Aii 105 : 11 CONTINUE 106 : IF (KMORS.JA(ICOL).LT.INTTT.AND.ICOL.LT.IFIN) THEN 107 : ICOL=ICOL+1 108 : GOTO 11 109 : ENDIF 110 : C On ne l'a pas trouvé 111 : IF (KMORS.JA(ICOL).NE.INTTT) THEN 112 : WRITE(IOIMP,*) 'diag.',INTTT,'inexistante' 113 : WRITE(IOIMP,*) 'le préconditionnement par la diag.' 114 : WRITE(IOIMP,*) 'est impossible.' 115 : IRET=-1 116 : GOTO 9999 117 : ELSE 118 : C On l'a trouvé 119 : VALPIV=KISA.A(ICOL) 120 : IF (VALPIV.LT.XPETIT) THEN 121 : NBPIVP=NBPIVP+1 122 : VALPIV=ONE 123 : ENDIF 124 : INVPIV.A(INTTT)=ONE/VALPIV 125 : ENDIF 126 : ELSE 127 : WRITE(IOIMP,*) 'Ligne',INTTT,'vide' 128 : WRITE(IOIMP,*) 'le préconditionnement par la diag.' 129 : WRITE(IOIMP,*) 'est impossible.' 130 : IRET=-3 131 : GOTO 9999 132 : ENDIF 133 : 1 CONTINUE 134 : * 135 : * Warning(s) 136 : * 137 : IF (NBPIVP.GT.0) THEN 138 : IF (IMPR.GT.1) THEN 139 : WRITE(IOIMP,*) 'WARNING !' 140 : WRITE(IOIMP,*) NBPIVP,' |diag.|<',XPETIT 141 : ENDIF 142 : ENDIF 143 : 144 : IF (IMPR.GT.6) THEN 145 : WRITE(IOIMP,*) 'création du pointeur INVPIV=',INVPIV 146 : IF (IMPR.GT.7) THEN 147 : WRITE(IOIMP,*) 'INVPIV.A(1..',NBVA,')= ' 148 : WRITE(IOIMP,1002)(INVPIV.A(II),II=1,NBVA) 149 : ENDIF 150 : ENDIF 151 : 152 : SEGDES KISA 153 : SEGDES KMORS 154 : SEGDES INVPIV 155 : C 156 : C On stocke l'inverse de la diagonale obtenue 157 : C 158 : SEGACT IDMAT*MOD 159 : IDIAG=INVPIV 160 : SEGDES IDMAT 161 : ELSE 162 : IF (IMPR.GT.6) THEN 163 : WRITE(IOIMP,*) 'Le préconditionneur est déjà construit :' 164 : WRITE(IOIMP,*) 'INVPIV=',INVPIV 165 : IF (IMPR.GT.7) THEN 166 : SEGACT INVPIV 167 : WRITE(IOIMP,*) 'INVPIV.A(1..',NBVA,')= ' 168 : WRITE(IOIMP,1002)(INVPIV.A(II),II=1,NBVA) 169 : SEGDES INVPIV 170 : ENDIF 171 : ENDIF 172 : ENDIF 173 : * 174 : * Normal termination 175 : * 176 : RETURN 177 : * 178 : * Format handling 179 : * 180 : 1002 FORMAT(10(1X,1PE11.4)) 181 : * 182 : * Error handling 183 : * 184 : 9999 CONTINUE 185 : WRITE(IOIMP,*) 'An error was detected in meidia.eso' 186 : RETURN 187 : * 188 : * End of MEIDIA 189 : * 190 : END 191 : 192 : 193 : 194 : 195 : 196 : 197 : 198 : 199 : 200 : 201 : 202 : 203 :
© Cast3M 2003 - All rights reserved.
Disclaimer