Sources Esope | Cast3M

fsma2d
C FSMA2D    SOURCE    OF166741  25/02/21    21:17:05     12166          
 
      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)
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
 
-INC SMCHAML
-INC SMELEME
-INC SMINTE
-INC SMCOORD
 
-INC TMPTVAL
 
      SEGMENT WORK
        REAL*8 XE(3,NBNN)
      ENDSEGMENT
 
      DIMENSION VEC(*),IPT(*)
C
C= Quelques constantes (2.Pi)
      PARAMETER (X2Pi=6.283185307179586476925286766559D0)
 
      MELVA1 = IPT(1)
      MELVA2 = IPT(2)
      IF (IPVECT.EQ.0) THEN
        IF (MELVA1.NE.0) THEN
          IGM1 = MELVA1.VELCHE(/1)
          IBM1 = MELVA1.VELCHE(/2)
        ENDIF
        IF (MELVA2.NE.0) THEN
          IGM2 = MELVA2.VELCHE(/1)
          IBM2 = MELVA2.VELCHE(/2)
        ENDIF
        V1 = XZero
        V2 = XZero
      ELSE
        V1 = VEC(1)
        V2 = VEC(2)
      ENDIF
C
      MINTE=IPTINT
      NBPGAU=POIGAU(/1)
C
      MELEME=IPMAIL
      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
 
      SEGSUP,WORK
 
c      RETURN
      END