C ECHI1 SOURCE GOUNAND 25/11/12 21:15:11 12399 SUBROUTINE ECHI1(IKAS,IVOL1,MTAB1,MTAB2,MPOVA1,MPOVA2,IKH,IKT, & MELEMD,MELEVF,MLENTI,MLENT1,NOMD) C----------------------------------------------------------------------- C Discrétisation de l'opérateur ECHIMP en explicite EFM1 et VF, le C coeff d'échange étant un SCAL ou CHPO CENTRE, le champ exterieur C un SCAL, un CHPO CENTRE ou un CHPO SOMMET. C----------------------------------------------------------------------- C C-------------------- C Paramètres Entrée : C-------------------- C C E/ IKAS : Type de situation à traiter (1=EF, 2 ou 3=VF) C E/ IVOL1 : Type d'échange (0=surfacique, 1=volumique) C E/ MTAB1 : Pointeur de la table EQEX C E/ MTAB2 : Pointeur de la table DOMAINE locale C E/ MPOVA1 : MPOVAL des valeurs du coefficient d'échange C E/ MPOVA2 : MPOVAL des valeurs du champ exterieur C E/ IKH : Forme originel du coefficient d'échange C (0=CHPO CENTRE, 1=FLOTTANT) C E/ IKT : Forme originel du champ exterieur C (0=CHPO CENTRE, 1=FLOTTANT, 4=CHPO SOMMET) C E/ MELEMD : Pointeur du spg de l'inconnue C E/ MELEVF : Pointeur vers les points CENTRE du maillage volumique C en correspondance avec les points CENTRE surfacique C (Utilisé en Formulation VF et échange surfacique) C E/ MLENTI : Correspondance numéotation globale/numérotation locale C LECT(I)=J : le point numéro I est le Jième de MELEMD C E/ MLENT1 : Idem MLENTI pour le spg du champ exterieur C (Utilisé lorsque le champ exterieur est au SOMMET) C E/ NOMD : Nom de l'inconnue C C------------------ C Champs calculés : C------------------ C C MPOVA3 : MPOVAL des valeurs de la matrice diagonale C Stocké à l'indice NOMD de la table KIZG1 C MPOVA4 : MPOVAL des valeurs du second membre C Stocké à l'indice NOMD de la table KIZG C C----------------------------------------------------------------------- IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C -INC PPARAM -INC CCOPTIO -INC SMCHPOI -INC SMCHAML -INC SMMATRIK -INC SMELEME POINTEUR MELEMD.MELEME -INC SMLENTI C CHARACTER*8 NOMD,TYPE,TYPC,TYPS C C- Initialisations C NBCOMP = 1 IF (IKAS.EQ.1) THEN TYPS = 'SOMMET ' ELSE TYPS = 'CENTRE ' ENDIF C NRIGE=7 NKID =9 NKMT =7 NMATRI=1 SEGINI MATRIK IRIGEL(1,1)=MELEMD IRIGEL(2,1)=MELEMD IRIGEL(7,1)=5 NBME=1 NBSOUS=1 SEGINI IMATRI IRIGEL(4,1)=IMATRI SEGACT MELEMD KSPGP=MELEMD KSPGD=MELEMD LISPRI(1)=NOMD LISDUA(1)=NOMD NP=1 MP=1 NBEL=MELEMD.NUM(/2) SEGINI IZAFM LIZAFM(1,1)=IZAFM LIZAFM(1,1)=IZAFM SEGDES MATRIK,IMATRI CALL KRCHPT(TYPS,MELEMD,NBCOMP,2,IZG,NOMD(1:4)) CALL LICHTM(IZG,MPOVA4,TYPC,IGEOM) C C- Activation C SEGACT MPOVA1 SEGACT MPOVA2 SEGACT MLENTI SEGACT MLENT1 C C---------------------------------------------------------------------- C- Traitement d'une formulation EF ou EMM1 explicite, le champ C- exterieur étant 1) un SCAL ou un CHPO CENTRE, 2) un CHPO SOMMET. C- Dans les deux cas, l'indice XXPSOML de la table domaine local suffit C- (contient l'intégrale sur chaque élément des fonctions de forme). C- En effet, en explicite les matrices masses sont condensées (EF=EFM1) C---------------------------------------------------------------------- C IF (IKAS.EQ.1) THEN CALL LEKTAB(MTAB2,'MAILLAGE',MELEME) CALL LEKTAB(MTAB2,'XXPSOML ',MCHELM) IF (IERR.NE.0) RETURN SEGACT MCHELM SEGACT MELEME NBSOUS = LISOUS(/1) IF (NBSOUS.EQ.0) NBSOUS=1 NUTOEL = 0 DO 30 L=1,NBSOUS IPT1 = MELEME IF (NBSOUS.NE.1) IPT1=LISOUS(L) SEGACT IPT1 NP = IPT1.NUM(/1) NBEL = IPT1.NUM(/2) MCHAML = ICHAML(L) SEGACT MCHAML MELVAL = IELVAL(1) SEGACT MELVAL DO 20 K=1,NBEL NK = NUTOEL + K KPOS = 1 + (1-IKH)*(NK-1) DO 10 I=1,NP II = IPT1.NUM(I,K) IPOS = LECT(II) VAL1 = MPOVA1.VPOCHA(KPOS,1)*VELCHE(I,K) AM(IPOS,1,1) = AM(IPOS,1,1) + VAL1 IF (IKT.EQ.4) THEN JPOS = MLENT1.LECT(II) ELSE JPOS = 1 + (1-IKT)*(NK-1) ENDIF VAL2 = VAL1 * MPOVA2.VPOCHA(JPOS,1) MPOVA4.VPOCHA(IPOS,1) = MPOVA4.VPOCHA(IPOS,1) + VAL2 10 CONTINUE 20 CONTINUE SEGDES IPT1 SEGDES MCHAML,MELVAL NUTOEL = NUTOEL + NBEL 30 CONTINUE IF (NBSOUS.NE.1) SEGDES MELEME SEGDES MCHELM C C---------------------------------------------------------------------- C- Traitement d'une formulation VF Explicite, le champ exterieur étant C- 1) un SCAL ou un CHPO CENTRE, 2) un CHPO SOMMET. C- C- Le traitement différe pour le second membre : C- Dans le premier cas, l'indice XXVOLUM de la table domaine local, C- utilisé pour calculer la matrice suffit (contient le volume de C- chaque élément). Dans le deuxième cas, on a également besoin de C- l'indice XXPSOML que l'on sature par le champ exterieur au sommet. C- C- Le spg des champoints résultats dépend du type d'échange : C- Lorsque l'échange est volumique, les points CENTRE de la table C- domaine local sont à considerer. En surfacique, on a construit C- la correspondance entre centre(volume)-centre(surface); les CENTRE C- des volumes concernés sont rangés dans MELEVF. C---------------------------------------------------------------------- C ELSE CALL LEKTAB(MTAB2,'XXVOLUM ',MCHPOI) CALL LICHTL(MCHPOI,MPOVA5,TYPC,MELEMC) IF (IVOL1.EQ.0) THEN IPT2 = MELEVF ELSE IPT2 = MELEMC ENDIF SEGACT IPT2 IF (IKT.EQ.0 .OR. IKT.EQ.1) THEN NBEL = IPT2.NUM(/2) DO 40 K=1,NBEL IPOS = LECT(IPT2.NUM(1,K)) KPOS = 1 + (1-IKH)*(K-1) KTEX = 1 + (1-IKT)*(K-1) VAL1 = MPOVA1.VPOCHA(KPOS,1) * MPOVA5.VPOCHA(K,1) AM(IPOS,1,1) = AM(IPOS,1,1) + VAL1 VAL2 = MPOVA2.VPOCHA(KTEX,1) * VAL1 MPOVA4.VPOCHA(IPOS,1) = MPOVA4.VPOCHA(IPOS,1) + VAL2 40 CONTINUE ELSE CALL LEKTAB(MTAB2,'MAILLAGE',MELEME) CALL LEKTAB(MTAB2,'XXPSOML ',MCHELM) IF (IERR.NE.0) RETURN SEGACT MCHELM SEGACT MELEME NBSOUS = LISOUS(/1) IF (NBSOUS.EQ.0) NBSOUS=1 NUTOEL = 0 DO 70 L=1,NBSOUS IPT1 = MELEME IF (NBSOUS.NE.1) IPT1=LISOUS(L) SEGACT IPT1 NP = IPT1.NUM(/1) NBEL = IPT1.NUM(/2) MCHAML = ICHAML(L) SEGACT MCHAML MELVAL = IELVAL(1) SEGACT MELVAL DO 60 K=1,NBEL NK = NUTOEL + K IPOS = LECT(IPT2.NUM(1,NK)) KPOS = 1 + (1-IKH)*(NK-1) VAL1 = MPOVA1.VPOCHA(KPOS,1) * MPOVA5.VPOCHA(NK,1) AM(IPOS,1,1) = AM(IPOS,1,1) + VAL1 VAL2 = 0.D0 DO 50 I=1,NP II = IPT1.NUM(I,K) JPOS = MLENT1.LECT(II) VAL2 = VAL2 + MPOVA1.VPOCHA(KPOS,1) & * MPOVA2.VPOCHA(JPOS,1) * VELCHE(I,K) 50 CONTINUE MPOVA4.VPOCHA(IPOS,1) = MPOVA4.VPOCHA(IPOS,1) + VAL2 60 CONTINUE NUTOEL = NUTOEL + NBEL SEGDES IPT1 SEGDES MELVAL,MCHAML 70 CONTINUE IF (NBSOUS.NE.1) SEGDES MELEME SEGDES MCHELM ENDIF SEGDES IPT2 SEGDES MPOVA5 ENDIF C C- Désactivation C SEGDES IZAFM SEGDES MPOVA1 SEGDES MPOVA2 SEGDES MPOVA4 SEGSUP MLENTI SEGSUP MLENT1 C CALL ECROBJ('MATRIK',MATRIK) CALL ECROBJ('CHPOINT',IZG) RETURN END