1 : C ECHI1 SOURCE MAGN 09/07/30 21:16:37 6458 2 : SUBROUTINE ECHI1(IKAS,IVOL1,MTAB1,MTAB2,MPOVA1,MPOVA2,IKH,IKT, 3 : & MELEMD,MELEVF,MLENTI,MLENT1,NOMD) 4 : C----------------------------------------------------------------------- 5 : C Discrétisation de l'opérateur ECHIMP en explicite EFM1 et VF, le 6 : C coeff d'échange étant un SCAL ou CHPO CENTRE, le champ exterieur 7 : C un SCAL, un CHPO CENTRE ou un CHPO SOMMET. 8 : C----------------------------------------------------------------------- 9 : C 10 : C-------------------- 11 : C Paramètres Entrée : 12 : C-------------------- 13 : C 14 : C E/ IKAS : Type de situation à traiter (1=EF, 2 ou 3=VF) 15 : C E/ IVOL1 : Type d'échange (0=surfacique, 1=volumique) 16 : C E/ MTAB1 : Pointeur de la table EQEX 17 : C E/ MTAB2 : Pointeur de la table DOMAINE locale 18 : C E/ MPOVA1 : MPOVAL des valeurs du coefficient d'échange 19 : C E/ MPOVA2 : MPOVAL des valeurs du champ exterieur 20 : C E/ IKH : Forme originel du coefficient d'échange 21 : C (0=CHPO CENTRE, 1=FLOTTANT) 22 : C E/ IKT : Forme originel du champ exterieur 23 : C (0=CHPO CENTRE, 1=FLOTTANT, 4=CHPO SOMMET) 24 : C E/ MELEMD : Pointeur du spg de l'inconnue 25 : C E/ MELEVF : Pointeur vers les points CENTRE du maillage volumique 26 : C en correspondance avec les points CENTRE surfacique 27 : C (Utilisé en Formulation VF et échange surfacique) 28 : C E/ MLENTI : Correspondance numéotation globale/numérotation locale 29 : C LECT(I)=J : le point numéro I est le Jième de MELEMD 30 : C E/ MLENT1 : Idem MLENTI pour le spg du champ exterieur 31 : C (Utilisé lorsque le champ exterieur est au SOMMET) 32 : C E/ NOMD : Nom de l'inconnue 33 : C 34 : C------------------ 35 : C Champs calculés : 36 : C------------------ 37 : C 38 : C MPOVA3 : MPOVAL des valeurs de la matrice diagonale 39 : C Stocké à l'indice NOMD de la table KIZG1 40 : C MPOVA4 : MPOVAL des valeurs du second membre 41 : C Stocké à l'indice NOMD de la table KIZG 42 : C 43 : C----------------------------------------------------------------------- 44 : IMPLICIT INTEGER(I-N) 45 : IMPLICIT REAL*8 (A-H,O-Z) 46 : C 47 : -INC CCOPTIO 48 : -INC SMCHPOI 49 : -INC SMCHAML 50 : -INC SMMATRIK 51 : -INC SMELEME 52 : POINTEUR MELEMD.MELEME 53 : -INC SMLENTI 54 : C 55 : CHARACTER*8 NOMD,TYPE,TYPC,TYPS 56 : C 57 : C- Initialisations 58 : C 59 : NBCOMP = 1 60 : IF (IKAS.EQ.1) THEN 61 : TYPS = 'SOMMET ' 62 : ELSE 63 : TYPS = 'CENTRE ' 64 : ENDIF 65 : C 66 : NRIGE=7 67 : NKID =9 68 : NKMT =7 69 : NMATRI=1 70 : SEGINI MATRIK 71 : IRIGEL(1,1)=MELEMD 72 : IRIGEL(2,1)=MELEMD 73 : IRIGEL(7,1)=5 74 : NBME=1 75 : NBSOUS=1 76 : SEGINI IMATRI 77 : IRIGEL(4,1)=IMATRI 78 : SEGACT MELEMD 79 : KSPGP=MELEMD 80 : KSPGD=MELEMD 81 : LISPRI(1)=NOMD 82 : LISDUA(1)=NOMD 83 : NP=1 84 : MP=1 85 : NBEL=MELEMD.NUM(/2) 86 : SEGINI IZAFM 87 : LIZAFM(1,1)=IZAFM 88 : LIZAFM(1,1)=IZAFM 89 : SEGDES MATRIK,IMATRI 89 : CALL KRCHPT(TYPS,MELEMD,NBCOMP,IZG,NOMD(1:4)) 89 : CALL LICHT(IZG,MPOVA4,TYPC,IGEOM) 90 : C 91 : C- Activation 92 : C 93 : SEGACT MPOVA1 94 : SEGACT MPOVA2 95 : SEGACT MLENTI 96 : SEGACT MLENT1 97 : C 98 : C---------------------------------------------------------------------- 99 : C- Traitement d'une formulation EF ou EMM1 explicite, le champ 100 : C- exterieur étant 1) un SCAL ou un CHPO CENTRE, 2) un CHPO SOMMET. 101 : C- Dans les deux cas, l'indice XXPSOML de la table domaine local suffit 102 : C- (contient l'intégrale sur chaque élément des fonctions de forme). 103 : C- En effet, en explicite les matrices masses sont condensées (EF=EFM1) 104 : C---------------------------------------------------------------------- 105 : C 106 : IF (IKAS.EQ.1) THEN 106 : CALL LEKTAB(MTAB2,'MAILLAGE',MELEME) 106 : CALL LEKTAB(MTAB2,'XXPSOML ',MCHELM) 107 : IF (IERR.NE.0) RETURN 108 : SEGACT MCHELM 109 : SEGACT MELEME 110 : NBSOUS = LISOUS(/1) 111 : IF (NBSOUS.EQ.0) NBSOUS=1 112 : NUTOEL = 0 113 : DO 30 L=1,NBSOUS 114 : IPT1 = MELEME 115 : IF (NBSOUS.NE.1) IPT1=LISOUS(L) 116 : SEGACT IPT1 117 : NP = IPT1.NUM(/1) 118 : NBEL = IPT1.NUM(/2) 119 : MCHAML = ICHAML(L) 120 : SEGACT MCHAML 121 : MELVAL = IELVAL(1) 122 : SEGACT MELVAL 123 : DO 20 K=1,NBEL 124 : NK = NUTOEL + K 125 : KPOS = 1 + (1-IKH)*(NK-1) 126 : DO 10 I=1,NP 127 : II = IPT1.NUM(I,K) 128 : IPOS = LECT(II) 129 : VAL1 = MPOVA1.VPOCHA(KPOS,1)*VELCHE(I,K) 130 : AM(IPOS,1,1) = AM(IPOS,1,1) + VAL1 131 : IF (IKT.EQ.4) THEN 132 : JPOS = MLENT1.LECT(II) 133 : ELSE 134 : JPOS = 1 + (1-IKT)*(NK-1) 135 : ENDIF 136 : VAL2 = VAL1 * MPOVA2.VPOCHA(JPOS,1) 137 : MPOVA4.VPOCHA(IPOS,1) = MPOVA4.VPOCHA(IPOS,1) + VAL2 138 : 10 CONTINUE 139 : 20 CONTINUE 140 : SEGDES IPT1 141 : SEGDES MCHAML,MELVAL 142 : NUTOEL = NUTOEL + NBEL 143 : 30 CONTINUE 144 : IF (NBSOUS.NE.1) SEGDES MELEME 145 : SEGDES MCHELM 146 : C 147 : C---------------------------------------------------------------------- 148 : C- Traitement d'une formulation VF Explicite, le champ exterieur étant 149 : C- 1) un SCAL ou un CHPO CENTRE, 2) un CHPO SOMMET. 150 : C- 151 : C- Le traitement différe pour le second membre : 152 : C- Dans le premier cas, l'indice XXVOLUM de la table domaine local, 153 : C- utilisé pour calculer la matrice suffit (contient le volume de 154 : C- chaque élément). Dans le deuxième cas, on a également besoin de 155 : C- l'indice XXPSOML que l'on sature par le champ exterieur au sommet. 156 : C- 157 : C- Le spg des champoints résultats dépend du type d'échange : 158 : C- Lorsque l'échange est volumique, les points CENTRE de la table 159 : C- domaine local sont à considerer. En surfacique, on a construit 160 : C- la correspondance entre centre(volume)-centre(surface); les CENTRE 161 : C- des volumes concernés sont rangés dans MELEVF. 162 : C---------------------------------------------------------------------- 163 : C 164 : ELSE 164 : CALL LEKTAB(MTAB2,'XXVOLUM ',MCHPOI) 164 : CALL LICHT(MCHPOI,MPOVA5,TYPC,MELEMC) 165 : IF (IVOL1.EQ.0) THEN 166 : IPT2 = MELEVF 167 : ELSE 168 : IPT2 = MELEMC 169 : ENDIF 170 : SEGACT IPT2 171 : IF (IKT.EQ.0 .OR. IKT.EQ.1) THEN 172 : NBEL = IPT2.NUM(/2) 173 : DO 40 K=1,NBEL 174 : IPOS = LECT(IPT2.NUM(1,K)) 175 : KPOS = 1 + (1-IKH)*(K-1) 176 : KTEX = 1 + (1-IKT)*(K-1) 177 : VAL1 = MPOVA1.VPOCHA(KPOS,1) * MPOVA5.VPOCHA(K,1) 178 : AM(IPOS,1,1) = AM(IPOS,1,1) + VAL1 179 : VAL2 = MPOVA2.VPOCHA(KTEX,1) * VAL1 180 : MPOVA4.VPOCHA(IPOS,1) = MPOVA4.VPOCHA(IPOS,1) + VAL2 181 : 40 CONTINUE 182 : ELSE 182 : CALL LEKTAB(MTAB2,'MAILLAGE',MELEME) 182 : CALL LEKTAB(MTAB2,'XXPSOML ',MCHELM) 183 : IF (IERR.NE.0) RETURN 184 : SEGACT MCHELM 185 : SEGACT MELEME 186 : NBSOUS = LISOUS(/1) 187 : IF (NBSOUS.EQ.0) NBSOUS=1 188 : NUTOEL = 0 189 : DO 70 L=1,NBSOUS 190 : IPT1 = MELEME 191 : IF (NBSOUS.NE.1) IPT1=LISOUS(L) 192 : SEGACT IPT1 193 : NP = IPT1.NUM(/1) 194 : NBEL = IPT1.NUM(/2) 195 : MCHAML = ICHAML(L) 196 : SEGACT MCHAML 197 : MELVAL = IELVAL(1) 198 : SEGACT MELVAL 199 : DO 60 K=1,NBEL 200 : NK = NUTOEL + K 201 : IPOS = LECT(IPT2.NUM(1,NK)) 202 : KPOS = 1 + (1-IKH)*(NK-1) 203 : VAL1 = MPOVA1.VPOCHA(KPOS,1) * MPOVA5.VPOCHA(NK,1) 204 : AM(IPOS,1,1) = AM(IPOS,1,1) + VAL1 205 : VAL2 = 0.D0 206 : DO 50 I=1,NP 207 : II = IPT1.NUM(I,K) 208 : JPOS = MLENT1.LECT(II) 209 : VAL2 = VAL2 + MPOVA1.VPOCHA(KPOS,1) 210 : & * MPOVA2.VPOCHA(JPOS,1) * VELCHE(I,K) 211 : 50 CONTINUE 212 : MPOVA4.VPOCHA(IPOS,1) = MPOVA4.VPOCHA(IPOS,1) + VAL2 213 : 60 CONTINUE 214 : NUTOEL = NUTOEL + NBEL 215 : SEGDES IPT1 216 : SEGDES MELVAL,MCHAML 217 : 70 CONTINUE 218 : IF (NBSOUS.NE.1) SEGDES MELEME 219 : SEGDES MCHELM 220 : ENDIF 221 : SEGDES IPT2 222 : SEGDES MPOVA5 223 : ENDIF 224 : C 225 : C- Désactivation 226 : C 227 : SEGDES MPOVA1 228 : SEGDES MPOVA2 229 : SEGDES MPOVA4 230 : SEGSUP MLENTI 231 : SEGSUP MLENT1 232 : C 232 : CALL ECROBJ('MATRIK',MATRIK) 232 : CALL ECROBJ('CHPOINT',IZG) 233 : 234 : RETURN 235 : END 236 : 237 : 238 : 239 : 240 : 241 :
© Cast3M 2003 - All rights reserved.
Disclaimer