C INTCN2    SOURCE    OF166741  24/08/06    21:15:03     11982          

************************************************************************
*
*                             I N T C N 2
*                             -----------
*
* FONCTION:
* ---------
*     INTEGRATION NUMERIQUE DANS UN DOMAINE BIDIMENSIONNEL DU PRODUIT:
*                     COEF. * TRANSPOSEE( N )
*     COEF. : GRANDEUR PHYSIQUE REPRESENTEE PAR UN CHAMELEM
*     N     : FONCTIONS DE FORME DE L'ELEMENT MAILLANT LE DOMAINE
*             CONSIDERE
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*
*     IPVATE  (E)  POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES
*                  VALEURS DE LA TEMPERATURE EXTERIEURE
*     IPVAHC  (E)  POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES
*                  VALEURS DU COEFFICIENT D'ECHANGE
*     IPGEOM  (E)  POINTEUR SUR UN OBJET MAILLAGE ELEMENTAIRE
*                  DU DOMAINE D'INTEGRATION
*     IPINTE  (E)  POINTEUR SUR UN SEGMENT MINTE CONTENANT LES
*                  CARACTERISTIQUES D'INTEGRATION
*     IPVAEQ  (S)  POINTEUR SUR UN SEGMENT MELVAL CONTENANT LES VALEURS
*                  NODALES EQUIVALENTES
* VARIABLES:
* ----------
*
*     XE(3,NBPTEL)  =  COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
*     A ET S        =  TABLEAUX DE TRAVAIL
*
* REMARQUES:
* ----------
*     L'UTILISATION DE CE S-P PRESUPPOSE UN PRE ET POST-TRAITEMENT
*     DES SEGMENTS MELVAL PASSES EN TANT QUE PARAMETRES
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*     DENIS ROBERT,LE 15 AVRIL 1988.
*
* LANGAGE:
* --------
*     ESOPE + FORTRAN77
*
************************************************************************

      SUBROUTINE INTCN2 (IPVATE,IPVAHC,IPGEOM,IPINTE,IPVAEQ)

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

-INC PPARAM
-INC CCOPTIO
-INC CCREEL
      PARAMETER (X2Pi=6.283185307179586476925286766559D0)

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

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

C ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
      MELEME = IPGEOM
      NBPTEL = meleme.NUM(/1)
      NEL    = meleme.NUM(/2)

C  ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION DES FACES
      MINTE  = IPINTE
      NBPGAU = minte.POIGAU(/1)

C  ON RECUPERE LES VALEURS DE LA TEMPERATURE
      MELVA1 = IPVATE
      N1_1   = MELVA1.VELCHE(/1)
      N2_1   = MELVA1.VELCHE(/2)

C  ON RECUPERE LES VALEURS DU COEFFICIENT
      MELVA2 = IPVAHC
      N1_2   = MELVA2.VELCHE(/1)
      N2_2   = MELVA2.VELCHE(/2)

C  INITIALISATION DU MELVAL QUI CONTIENDRA LES VALEURS EQUIVALENTES
      N1PTEL = NBPTEL
      N1EL   = NEL
      N2PTEL = 0
      N2EL   = 0
      SEGINI,MELVAL

      SEGINI,MMAT1

* ========
*  BOUCLE (1) SUR LES ELEMENTS
* ========
      DO IEL = 1, NEL

        IEMN1 = MIN(IEL,N2_1)
        IEMN2 = MIN(IEL,N2_2)

        DO INOE = 1, NBPTEL
          AEL(INOE) = XZERO
        ENDDO

*        ON CHERCHE LES COORDONNEES DES NOEUDS DANS LE REPERE GLOBAL
*
        CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XEL)

* ========
*  BOUCLE (10) SUR LES POINTS D'INTEGRATION
* ========
        DO IGAU = 1, NBPGAU

*           CALCUL DU JACOBIEN AU POINT DE GAUSS CONSIDERE
          DO IP = 1, 2
            IP1 = IP + 1
            DO IQ = 1, 3
              r_z = XZERO
              DO INOE = 1, NBPTEL
                r_z = r_z + SHPTOT(IP1,INOE,IGAU)*XEL(IQ,INOE)
              END DO
              S(IP,IQ) = r_z
            END DO
          END DO
          S1 = S(1,2)*S(2,3)-S(1,3)*S(2,2)
          S2 = S(1,3)*S(2,1)-S(1,1)*S(2,3)
          S3 = S(1,1)*S(2,2)-S(1,2)*S(2,1)
          DJAC = POIGAU(IGAU) * SQRT ( S1*S1 + S2*S2 + S3*S3 )

*      CAS DES ELEMENTS AXISYMETRIQUES
          IF (IFOMOD.EQ.0) THEN
            RR = XZERO
            DO INOE = 1, NBPTEL
              RR = RR + SHPTOT(1,INOE,IGAU)*XEL(1,INOEL)
            END DO
            DJAC = X2Pi * RR * DJAC
          ENDIF

          INMN1 = MIN(IGAU,N1_1)
          INMN2 = MIN(IGAU,N1_2)
          r_z = MELVA1.VELCHE(INMN1,IEMN1) * MELVA2.VELCHE(INMN2,IEMN2)

          r_z = r_z * DJAC
          DO INOE = 1, NBPTEL
            AEL(INOE) = AEL(INOE) + SHPTOT(1,INOE,IGAU) * r_z
          END DO

        END DO
* ========
*  BOUCLE (10) FIN
* ========

        DO INOE = 1, NBPTEL
          VELCHE(INOE,IEL) = AEL(INOE)
        END DO

      END DO
* ========
*  BOUCLE (1) - FIN
* ========

      SEGSUP,MMAT1

      IPVAEQ = MELVAL

c      return
      END