C CHAMA3    SOURCE    FANDEUR   10/12/17    21:16:03     6427           

C=======================================================================
C=                            C H A M A 3                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=   Calcul du MCHAML (champ par element aux noeuds) des flux nodaux   =
C=   equivalents a des sources volumiques. Cas TRIDIMENSIONNEL MASSIF  =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   IPSONO   (E)   Pointeur sur le segment MELVAL des SOURCES         =
C=   IPGEOM   (E)   Pointeur sur un objet MAILLAGE elementaire         =
C=   IPINTE   (E)   Pointeur sur un segment MINTE contenant les        =
C=                  caracteristiques d'integration                     =
C=   IPCHEQ   (S)   Pointeur sur un segment MELVAL contenant les       =
C=                  flux de chaleur nodaux equivalents                 =
C=                                                                     =
C=  Variables locales :                                                =
C=  -------------------                                                =
C=   XEL(3,NBPTEL)  Coordonnees GLOBALES des noeuds d'un element       =
C=   VOLU           Volume elementaire au point de Gauss               =
C=   AEL            Matrice de travail                                 =
C=                                                                     =
C=  Denis ROBERT, le 16 fevrier 1988.                                  =
C=======================================================================

      SUBROUTINE CHAMA3 (IPSONO,IPGEOM,IPINTE, IPCHEQ)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC CCREEL
-INC CCOPTIO

-INC SMCHAML
-INC SMELEME
-INC SMINTE
-INC SMCOORD

      SEGMENT MMAT1
        REAL*8 XEL(3,NBPTEL), AEL(NBPTEL,NBPTEL)
      ENDSEGMENT

C  1 - INITIALISATION
C ====================
C  1.1 - Recuperation d'informations sur le maillage elementaire
C =====
      MELEME=IPGEOM
      SEGACT,MELEME
      NBPTEL=NUM(/1)
      NbElt=NUM(/2)
C =====
C  1.2 - Recuperation d'informations sur l'element fini du maillage
C =====
      MINTE=IPINTE
      SEGACT,MINTE
      NBPGAU=POIGAU(/1)
      NBNO=SHPTOT(/2)
C =====
C  1.3 - Activation du MCHAML contenant les valeurs des sources
C =====
      MELVA1=IPSONO
      SEGACT,MELVA1
      NBPTE1=MELVA1.VELCHE(/1)
      NEL1=MELVA1.VELCHE(/2)
C =====
C  1.4 - Initialisation du segment de travail MMAT1
C =====
      SEGINI,MMAT1
C =====
C  1.5 - Initialisation du segment resultat MELVAL contenant les valeurs
C        des flux nodaux pour chaque element du maillage (IPGEOM)
C =====
      N1PTEL=NBPTEL
      N1EL=NbElt
      N2PTEL=0
      N2EL=0
      SEGINI,MELVAL
      IPCHEQ=MELVAL

C  2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAMOD
C ============================================================
      DO iElt=1,NbElt
C =====
C  2.1 - Mise a zero de la matrice symetrique AEL(i,j)=Forme(i).Forme(j)
C =====
        CALL ZERO(AEL,NBPTEL,NBPTEL)
C =====
C  2.2 - Recuperation des coordonnees GLOBALES des noeuds de l'element
C =====
        CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,iElt,XEL)
C =====
C  2.3 - Boucle sur les points de Gauss de l'element iElt
C =====
        DO iGau=1,NBPGAU
C =======
C  2.3.1 - Calcul du volume associe au point de Gauss iGau
C =======
          V1=XZERO
          V2=XZERO
          V3=XZERO
          V4=XZERO
          V5=XZERO
          V6=XZERO
          V7=XZERO
          V8=XZERO
          V9=XZERO
          DO i=1,NBPTEL
            V1=V1+SHPTOT(2,i,iGau)*XEL(2,i)
            V2=V2+SHPTOT(3,i,iGau)*XEL(3,i)
            V3=V3+SHPTOT(3,i,iGau)*XEL(2,i)
            V4=V4+SHPTOT(2,i,iGau)*XEL(3,i)
            V5=V5+SHPTOT(3,i,iGau)*XEL(1,i)
            V6=V6+SHPTOT(2,i,iGau)*XEL(1,i)
            V7=V7+SHPTOT(4,i,iGau)*XEL(1,i)
            V8=V8+SHPTOT(4,i,iGau)*XEL(2,i)
            V9=V9+SHPTOT(4,i,iGau)*XEL(3,i)
          ENDDO
          Volu=(V3*V9-V2*V8)*V6+(V2*V7-V5*V9)*V1+(V5*V8-V3*V7)*V4
          Volu=ABS(Volu)*POIGAU(iGau)
C =======
C  2.3.2 - Calcul de la contribution du point de Gauss a la matrice AEL
C =======
          DO i=1,NBPTEL
            Z=SHPTOT(1,i,iGau)*Volu
            DO j=1,NBPTEL
              AEL(i,j)=AEL(i,j)+SHPTOT(1,j,iGau)*Z
            ENDDO
          ENDDO
        ENDDO
C =====
C  2.4 - Calcul des flux equivalents sur cet element (MCHAML aux noeuds)
C =====
        IEMIN=MIN(NEL1,iElt)
        DO i=1,NBPTEL
          Z=XZERO
          DO j=1,NBPTEL
            k=MIN(NBPTE1,j)
            Z=Z+MELVA1.VELCHE(k,IEMIN)*AEL(j,i)
          ENDDO
          VELCHE(i,iElt)=Z
        ENDDO
      ENDDO

C  3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
C ====================================================
      SEGSUP,MMAT1
      SEGDES,MELEME,MELVA1,MINTE,MELVAL

      RETURN
      END