C FSMA2D    SOURCE    FANDEUR   12/07/18    21:15:40     7434           

      SUBROUTINE FSMA2D(IPT,IPMAIL,IPTINT,IPVECT,VEC,IVAFOR,IVACAR)
C     
C____________________________________________________________________
C   CALCULE LES FORCES SURFACIQUES SUR LES FACES D ELEMENTS
C   MASSIFS BIDIMENSIONNELS
C     
C   ENTREES :
C   ---------
C     
C    IPT     TABLEAU DE POINTEUR SUR UN MELVAL CONTENANT LES FORCES
C            APPLIQUEES
C            0  SI ON A DONNE UN VECTEUR CONSTANT
C    IPMAIL  POINTEUR SUR UN OBJET GEOMETRIQUE
C    IPTINT  POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION
C    IPVECT  POINTEUR SUR LE VECTEUR REPRESENTANT LA FORCE
C    VEC     VECTEUR REPRESENTANT LA FORCE
C    IVAFOR  POINTEUR SUR UN MPTVAL ET LES MELVALS CONTENANT LES FORCES
C            NODALES RESULTANTES
C    IVACAR  POINTEUR SUR UN MELVAL DE CARACTERISTIQUES
C     
C____________________________________________________________________
C     
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C     
-INC CCOPTIO
-INC CCREEL

-INC SMCHAML
-INC SMELEME
-INC SMINTE
-INC SMCOORD
C     
      SEGMENT WORK
        REAL*8 XE(3,NBNN)
      ENDSEGMENT
C     
      SEGMENT MPTVAL
        INTEGER IPOS(NS)    ,NSOF(NS)
        INTEGER      IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
C     
      DIMENSION VEC(*),IPT(*)
C     
C= Quelques constantes (2.Pi)
      PARAMETER (X2Pi=6.283185307179586476925286766559D0)
C     
      MELVA1 = IPT(1)
      MELVA2 = IPT(2)
      IF (IPVECT.EQ.0) THEN
        IF (MELVA1.NE.0) THEN
          SEGACT,MELVA1
          IGM1 = MELVA1.VELCHE(/1)
          IBM1 = MELVA1.VELCHE(/2)
        ENDIF
        IF (MELVA2.NE.0) THEN
          SEGACT,MELVA2
          IGM2 = MELVA2.VELCHE(/1)
          IBM2 = MELVA2.VELCHE(/2)
        ENDIF
        V1 = XZero
        V2 = XZero
      ELSE
        V1 = VEC(1)
        V2 = VEC(2)
      ENDIF
C     
      MINTE=IPTINT
C*      SEGACT MINTE           <- ACTIF EN E/S (NON MODIFIE)
      NBPGAU=POIGAU(/1)
C     
      MELEME=IPMAIL
C*      SEGACT,MELEME          <- ACTIF EN E/S (NON MODIFIE)
      NBNN  =NUM(/1)
      NBELEM=NUM(/2)
C
      SEGINI,WORK
C     
C   RECUPERATION DE L'EPAISSEUR (CONTRAINTES PLANES) :
C     
      DIM3 = 1.D0
      MELVA6 = 0
      IF (IFOUR.EQ.-2) THEN
        IF (IVACAR.NE.0) THEN
          MPTVAL = IVACAR
          MELVA6 = IVAL(1)
          IF (MELVA6.NE.0) THEN
            IGEP = MELVA6.VELCHE(/1)
            IBEP = MELVA6.VELCHE(/2)
          ENDIF
        ENDIF
      ENDIF
C     
C     BOUCLE SUR LES ELEMENTS
C     
      DO 1 IB=1,NBELEM
C     
        CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
C
        IF (MELVA6.NE.0) IBME = MIN(IB,IBEP)
        IF (IPVECT.EQ.0) THEN
          IF (MELVA1.NE.0) IB1 = MIN(IB,IBM1)
          IF (MELVA2.NE.0) IB2 = MIN(IB,IBM2)
        ENDIF
C     
C       BOUCLE SUR LES POINTS DE GAUSS
C     
        DO 10 IGAU=1,NBPGAU
C     
C   RECUPERATION DE L'EPAISSEUR
C     
          IF (MELVA6.NE.0) THEN
            IGMN = MIN(IGAU,IGEP)
            DIM3 = MELVA6.VELCHE(IGMN,IBME)
          ENDIF
C     
          VNQSI1=0.D0
          VNQSI2=0.D0
          DO 20 I=1,NBNN
            VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
            VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
 20       CONTINUE
          ZN = SQRT(VNQSI1*VNQSI1 + VNQSI2*VNQSI2)
          X = VNQSI1 / ZN
          Y = VNQSI2 / ZN

          IF (IFOUR.LT.0) THEN
            IF (IFOUR.EQ.-2) THEN
              R = DIM3
            ELSE
              R = 1.D0
            ENDIF
          ELSE
            R=0.D0
            DO 21 I=1,NBNN
              R = R + SHPTOT(1,I,IGAU)*XE(1,I)
 21         CONTINUE
            IF (IFOUR.EQ.0) THEN
              R = X2Pi*R
C*          ELSE IF (IFOUR.EQ.1) THEN
            ELSE
              IF (NIFOUR.EQ.0) THEN
                R = X2Pi*R
              ELSE
                R = XPI*R
              ENDIF
            ENDIF
          ENDIF
          WGPGAU = POIGAU(IGAU)*R
*     
          IF (IPVECT.EQ.0) THEN
            IF (MELVA1.NE.0) THEN
              IGMN = MIN(IGAU,IGM1)
              V1 = MELVA1.VELCHE(IGMN,IB1)
            ENDIF
            IF (MELVA2.NE.0) THEN
              IGMN = MIN(IGAU,IGM2)
              V2 = MELVA2.VELCHE(IGMN,IB2)
            ENDIF
          ENDIF

* changement de repere du vecteur force
          VECT = X*V1 + Y*V2
          VECN = X*V2 - Y*V1
          T1 = WGPGAU * ( VNQSI1*VECT - VNQSI2*VECN )
          T2 = WGPGAU * ( VNQSI1*VECN + VNQSI2*VECT )
C     
          MPTVAL = IVAFOR
          DO 30 J = 1, NBNN
            MELVAL=IVAL(1)
            VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1
            MELVAL=IVAL(2)
            VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2
 30       CONTINUE
C     
 10     CONTINUE

 1    CONTINUE

C*    SEGDES,MELEME          <- ACTIF EN E/S (NON MODIFIE)
C*    SEGDES MINTE           <- ACTIF EN E/S (NON MODIFIE)
      SEGSUP,WORK
      IF (IPVECT.EQ.0) THEN
        IF (MELVA1.NE.0) SEGDES,MELVA1
        IF (MELVA2.NE.0) SEGDES,MELVA2
      ENDIF

      RETURN
      END